diff --git a/BDAccess/app.R b/BDAccess/app.R index 77f37fd..fb45b84 100644 --- a/BDAccess/app.R +++ b/BDAccess/app.R @@ -2,7 +2,6 @@ library(shiny) library(rhandsontable) print(getwd()) -print(file) source("../sqlFunctions.R", encoding = "UTF-8") DF<-data.frame("NHC"="","Samples"="") @@ -28,7 +27,7 @@ ui <- fluidPage( hr(), fileInput(inputId = "file_query", label = "Plantilla", multiple = F), actionButton("impNHC", "Importa NHC"), - actionButton("goButton", "Genera UMID"), + actionButton("goButton", "Genera CodiID"), hr(), actionButton("filltemplate", "Plantilla"), hr(), @@ -59,8 +58,17 @@ server <- function(input, output) { values[["Excel"]]<-"" observeEvent(input$butdbtype, { - dta<<-odbcConnectAccess2007(access.file = file, - pwd = .rs.askForPassword("Enter password:")) + print(UMfile) + print(OVfile) + if (input$dbtype == "UM"){ + dta<<-odbcConnectAccess2007(access.file = UMfile, + pwd = .rs.askForPassword("Enter password:")) + } + if (input$dbtype == "OV"){ + dta<<-odbcConnectAccess2007(access.file = OVfile, + pwd = .rs.askForPassword("Enter password:")) + } + print(dta) if (input$backup == T){ sqlBackUp() @@ -86,7 +94,7 @@ server <- function(input, output) { observeEvent(input$impNHC, { values[["DF"]]$NHC<-values[["Excel"]] }) - + ## Handsontable observe({ if (!is.null(input$hot)) { @@ -109,7 +117,6 @@ server <- function(input, output) { }) observe({ - print(1) if (!is.null(input$samples)) { samples = hot_to_r(input$samples) } else { @@ -190,145 +197,236 @@ server <- function(input, output) { }) observeEvent(input$goButton, { - print(dta) - sqlGenOVID(nhcs = values[["DF"]]$NHC, sinc=T) - values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "UMID")) + + sqlGenOVID(dta, nhcs = values[["DF"]]$NHC, sinc=T) + + if (input$dbtype == "UM"){ + values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "UMID")) + } + if (input$dbtype == "OV"){ + values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "OVID")) + } print(values[["DF"]]) }) observeEvent(input$filltemplate,{ today=T - - upd.umid<-sqlFetch(dta, "UMID") %>% filter(NHC %in% values[["DF"]]$NHC) - ## Generar código para las nuevas muestras - samples<-sqlFetch(dta, "MUESTRAS") - if(sum(grepl(paste0("UM",Sys.time() %>% format("%y")), samples$CODIGO)) > 0){ - next.samp<-gsub(paste0("UM",Sys.time() %>% format("%y")),"", samples$CODIGO) %>% as.numeric %>% max(na.rm=T)+1 - }else{ - next.samp<-1 - } - last.samp<-next.samp+(length(values[["DF"]]$NHC)-1) - new.samp<-sprintf("UM%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp) - new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "CODIGO"=new.samp) %>% merge(sqlFetch(dta,"UMID"), all.x=T) %>% arrange(CODIGO) - samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO) - if (today==TRUE){ - samples.exp$FECHA_RECEPCION<-format(Sys.Date(), "%d/%m/%y") - } - - nhc.table<-values[["DF"]] - - if (any(sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]) == T)){ - nhcs.cnag<-nhc.table[sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]),"NHC"] - umid.cnag<-sqlFetch(dta, "UMID") %>% filter(NHC %in% nhcs.cnag) %>% pull(UMID) - sample.cnag<-samples.exp %>% filter(UMID %in% umid.cnag) %>% pull(CODIGO) - cnag.exp<-merge(data.frame("UMID"=umid.cnag, "CODIGO"=sample.cnag), sqlFetch(dta, "CNAG") %>% slice(0), all=T) + if (input$dbtype == "UM"){ + upd.umid<-sqlFetch(dta, "UMID") %>% filter(NHC %in% values[["DF"]]$NHC) + ## Generar código para las nuevas muestras + samples<-sqlFetch(dta, "MUESTRAS") + if(sum(grepl(paste0("UM",Sys.time() %>% format("%y")), samples$CODIGO)) > 0){ + next.samp<-gsub(paste0("UM",Sys.time() %>% format("%y")),"", samples$CODIGO) %>% as.numeric %>% max(na.rm=T)+1 + }else{ + next.samp<-1 + } + last.samp<-next.samp+(length(values[["DF"]]$NHC)-1) + new.samp<-sprintf("UM%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp) + new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "CODIGO"=new.samp) %>% merge(sqlFetch(dta,"UMID"), all.x=T) %>% arrange(CODIGO) + samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO) if (today==TRUE){ - cnag.exp$FECHA_ENVIO<-format(Sys.Date(), "%d/%m/%y") + samples.exp$FECHA_RECEPCION<-format(Sys.Date(), "%d/%m/%y") } - }else{ - cnag.exp<-sqlFetch(dta, "CNAG") %>% slice(0) %>% - mutate(across(lubridate::is.POSIXct, as.character)) + + nhc.table<-values[["DF"]] + + if (any(sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]) == T)){ + nhcs.cnag<-nhc.table[sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]),"NHC"] + umid.cnag<-sqlFetch(dta, "UMID") %>% filter(NHC %in% nhcs.cnag) %>% pull(UMID) + sample.cnag<-samples.exp %>% filter(UMID %in% umid.cnag) %>% pull(CODIGO) + cnag.exp<-merge(data.frame("UMID"=umid.cnag, "CODIGO"=sample.cnag), sqlFetch(dta, "CNAG") %>% slice(0), all=T) + if (today==TRUE){ + cnag.exp$FECHA_ENVIO<-format(Sys.Date(), "%d/%m/%y") + } + }else{ + cnag.exp<-sqlFetch(dta, "CNAG") %>% slice(0) %>% + mutate(across(lubridate::is.POSIXct, as.character)) + } + if (any(sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]) == T)){ + nhcs.rna<-nhc.table[sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]),"NHC"] + umid.rna<-sqlFetch(dta, "UMID") %>% filter(NHC %in% nhcs.rna) %>% pull(UMID) + sample.rna<-samples.exp %>% filter(UMID %in% umid.rna) %>% pull(CODIGO) + rna.exp<-merge(data.frame("UMID"=umid.rna, "CODIGO"=sample.rna), sqlFetch(dta, "RNADNA") %>% slice(0)%>% + mutate(across(lubridate::is.POSIXct, as.character)), all=T) + }else{ + rna.exp<-sqlFetch(dta, "RNADNA") %>% slice(0) %>% + mutate(across(lubridate::is.POSIXct, as.character)) + } + + ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos + upd.clinics<-sqlFetch(dta, "CLINICOS") + umid.new<-sqlFetch(dta, "UMID") %>% filter(NHC %in% values[["DF"]]$NHC) + upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="UMID") + upd.clinics$NHC<-as.character(upd.clinics$NHC) + for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])} + + values[["samples"]]<-samples.exp + values[["CLINICS"]]<-upd.clinics + values[["cnag"]]<-cnag.exp + values[["rna"]]<-rna.exp + } + if (input$dbtype == "OV"){ + upd.umid<-sqlFetch(dta, "OVID") %>% filter(NHC %in% values[["DF"]]$NHC) + ## Generar código para las nuevas muestras + samples<-sqlFetch(dta, "SAMPLES") + if(sum(grepl(paste0("OV",Sys.time() %>% format("%y")), samples$samples)) > 0){ + next.samp<-gsub(paste0("OV",Sys.time() %>% format("%y")),"", samples$samples) %>% as.numeric %>% max(na.rm=T)+1 + }else{ + next.samp<-1 } - if (any(sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]) == T)){ - nhcs.rna<-nhc.table[sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]),"NHC"] - umid.rna<-sqlFetch(dta, "UMID") %>% filter(NHC %in% nhcs.rna) %>% pull(UMID) - sample.rna<-samples.exp %>% filter(UMID %in% umid.rna) %>% pull(CODIGO) - rna.exp<-merge(data.frame("UMID"=umid.rna, "CODIGO"=sample.rna), sqlFetch(dta, "RNADNA") %>% slice(0)%>% - mutate(across(lubridate::is.POSIXct, as.character)), all=T) - }else{ - rna.exp<-sqlFetch(dta, "RNADNA") %>% slice(0) %>% - mutate(across(lubridate::is.POSIXct, as.character)) + last.samp<-next.samp+(length(values[["DF"]]$NHC)-1) + new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp) + new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "samples"=new.samp) %>% merge(sqlFetch(dta,"OVID"), all.x=T) %>% arrange(samples) + samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples) + if (today==TRUE){ + samples.exp$IQ_date<-format(Sys.Date(), "%d/%m/%y") } - - ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos - upd.clinics<-sqlFetch(dta, "CLINICOS") - umid.new<-sqlFetch(dta, "UMID") %>% filter(NHC %in% values[["DF"]]$NHC) - upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="UMID") - upd.clinics$NHC<-as.character(upd.clinics$NHC) - for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])} - - values[["samples"]]<-samples.exp - values[["CLINICS"]]<-upd.clinics - values[["cnag"]]<-cnag.exp - values[["rna"]]<-rna.exp - - print(values[["rna"]] %>% sapply(class)) + + nhc.table<-values[["DF"]] + + ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos + upd.clinics<-sqlFetch(dta, "CLINICS") + umid.new<-sqlFetch(dta, "OVID") %>% filter(NHC %in% values[["DF"]]$NHC) + upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="OVID") + upd.clinics$NHC<-as.character(upd.clinics$NHC) + for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])} + + values[["samples"]]<-samples.exp %>% mutate(across(lubridate::is.POSIXct, as.character)) + values[["CLINICS"]]<-upd.clinics %>% mutate(across(lubridate::is.POSIXct, as.character)) + } }) observeEvent(input$synctemplate,{ + if (input$dbtype == "UM"){ + # conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clinics=F, dbtype=NULL + + ## Nuevas entradas en MUESTRAS + nsamples<-values[["samples"]] %>% nrow + upd.samples<-values[["samples"]] + if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character} + + if (nrow(upd.samples) > 0){ + upd.samples$FECHA_RECEPCION<-lubridate::parse_date_time(upd.samples$FECHA_RECEPCION, c("d/m/Y","d/m/y")) %>% as.Date() + upd.samples$TIPO<-as.character(upd.samples$TIPO) + upd.samples$OBS<-as.character(upd.samples$OBS) + ### !! Atención, esto cambia la base de datos: + sqlSave(dta, upd.samples, tablename="MUESTRAS", append = T, varTypes = c("FECHA_RECEPCION"="Date"), rownames = F) + print("Tabla MUESTRAS sincronizada.") + } - # conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clinics=F, dbtype=NULL - - ## Nuevas entradas en MUESTRAS - nsamples<-values[["samples"]] %>% nrow - upd.samples<-values[["samples"]] - if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character} - - if (nrow(upd.samples) > 0){ - upd.samples$FECHA_RECEPCION<-lubridate::parse_date_time(upd.samples$FECHA_RECEPCION, c("d/m/Y","d/m/y")) %>% as.Date() - upd.samples$TIPO<-as.character(upd.samples$TIPO) - upd.samples$OBS<-as.character(upd.samples$OBS) + ## Entradas modificadas en CLINICOS + upd.clinics<-values[["CLINICS"]] + umid.mod<-upd.clinics$UMID[upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))] + rnames<-sqlFetch(dta, "CLINICOS") %>% filter(UMID %in% umid.mod) %>% rownames + clinics.mod<-upd.clinics %>% filter(UMID %in% umid.mod) %>% select(-NHC) + rownames(clinics.mod)<-rnames + ### !! Atención, esto cambia la base de datos: - print(upd.samples) - sqlSave(dta, upd.samples, tablename="MUESTRAS", append = T, varTypes = c("FECHA_RECEPCION"="Date"), rownames = F) - print("Tabla MUESTRAS sincronizada.") - } - - ## Entradas modificadas en CLINICOS - upd.clinics<-values[["CLINICS"]] - umid.mod<-upd.clinics$UMID[upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))] - rnames<-sqlFetch(dta, "CLINICOS") %>% filter(UMID %in% umid.mod) %>% rownames - clinics.mod<-upd.clinics %>% filter(UMID %in% umid.mod) %>% select(-NHC) - rownames(clinics.mod)<-rnames - - ### !! Atención, esto cambia la base de datos: - fechas<-colnames(clinics.mod)[grepl("date|MET_DX|DoB", colnames(clinics.mod), ignore.case = T)] - for (i in fechas){ - clinics.mod[,i]<-lubridate::parse_date_time(clinics.mod[,i], c("d/m/Y","d/m/y")) %>% as.Date() - } - sqlUpdate(dta, clinics.mod,"CLINICOS", index="UMID") - print("Tabla CLINICOS modificada.") - - ## Nuevas entradas en CLINICOS - nsamples.clin<-sqlFetch(dta, "CLINICOS") %>% nrow - umid.new<-upd.clinics$UMID[!upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))] - clinics.new<-upd.clinics %>% filter(UMID %in% umid.new) %>% select(-NHC) - if (length(umid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character} - - ### !! Atención, esto cambia la base de datos: - fechas<-colnames(clinics.new)[grepl("date|MET_DX|DoB", colnames(clinics.new), ignore.case = T)] - varTypes<-rep("Date",length(fechas)) - names(varTypes)<-fechas - for (i in fechas){ - clinics.new[,i]<-lubridate::parse_date_time(clinics.new[,i], c("d/m/Y","d/m/y")) %>% as.Date() - } - sqlSave(dta, clinics.new, tablename="CLINICOS", append = T, varTypes = varTypes, rownames = F) - print("Tabla CLINICOS sincronizada.") - - ## Nuevas entradas en CNAG - if (nrow(values[["cnag"]]) > 0){ - cnag.sync<-values[["cnag"]] - fechas<-colnames(cnag.sync)[sqlFetch(dta, "CNAG") %>% sapply(lubridate::is.POSIXct)] + fechas<-colnames(clinics.mod)[grepl("date|MET_DX|DoB", colnames(clinics.mod), ignore.case = T)] + for (i in fechas){ + clinics.mod[,i]<-lubridate::parse_date_time(clinics.mod[,i], c("d/m/Y","d/m/y")) %>% as.Date() + } + sqlUpdate(dta, clinics.mod,"CLINICOS", index="UMID") + print("Tabla CLINICOS modificada.") + + ## Nuevas entradas en CLINICOS + nsamples.clin<-sqlFetch(dta, "CLINICOS") %>% nrow + umid.new<-upd.clinics$UMID[!upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))] + clinics.new<-upd.clinics %>% filter(UMID %in% umid.new) %>% select(-NHC) + if (length(umid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character} + + ### !! Atención, esto cambia la base de datos: + fechas<-colnames(clinics.new)[grepl("date|MET_DX|DoB", colnames(clinics.new), ignore.case = T)] varTypes<-rep("Date",length(fechas)) names(varTypes)<-fechas - print(fechas) for (i in fechas){ - cnag.sync[,i]<-lubridate::parse_date_time(cnag.sync[,i], c("d/m/Y","d/m/y")) %>% as.Date() + clinics.new[,i]<-lubridate::parse_date_time(clinics.new[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date() + } + sqlSave(dta, clinics.new, tablename="CLINICOS", append = T, varTypes = varTypes, rownames = F) + print("Tabla CLINICOS sincronizada.") + + ## Nuevas entradas en CNAG + if (nrow(values[["cnag"]]) > 0){ + cnag.sync<-values[["cnag"]] + fechas<-colnames(cnag.sync)[sqlFetch(dta, "CNAG") %>% sapply(lubridate::is.POSIXct)] + varTypes<-rep("Date",length(fechas)) + names(varTypes)<-fechas + print(fechas) + for (i in fechas){ + cnag.sync[,i]<-lubridate::parse_date_time(cnag.sync[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date() + } + sqlSave(dta, cnag.sync, tablename="CNAG", append = T, varTypes = varTypes, rownames = F) + } + + ## Nuevas entradas en RNADNA + if (nrow(values[["rna"]]) > 0){ + rna.sync<-values[["rna"]] + fechas<-colnames(rna.sync)[sqlFetch(dta, "RNADNA") %>% sapply(lubridate::is.POSIXct)] + varTypes<-rep("Date",length(fechas)) + names(varTypes)<-fechas + for (i in fechas){ + rna.sync[,i]<-lubridate::parse_date_time(rna.sync[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date() + } + sqlSave(dta, rna.sync, tablename="RNADNA", append = T, varTypes = varTypes, rownames = F) } - sqlSave(dta, cnag.sync, tablename="CNAG", append = T, varTypes = varTypes, rownames = F) } - - ## Nuevas entradas en RNADNA - if (nrow(values[["rna"]]) > 0){ - rna.sync<-values[["rna"]] - fechas<-colnames(rna.sync)[sqlFetch(dta, "RNADNA") %>% sapply(lubridate::is.POSIXct)] + if (input$dbtype == "OV"){ + ## Nuevas entradas en SAMPLES + nsamples<-values[["samples"]] %>% nrow + upd.samples<-values[["samples"]] + if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character} + + if (nrow(upd.samples) > 0){ + fechas<-colnames(upd.samples)[sqlFetch(dta, "SAMPLES") %>% sapply(lubridate::is.POSIXct)] + for (i in fechas){ + upd.samples[,i]<-lubridate::parse_date_time(upd.samples[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date() + } + varTypes<-rep("Date",length(fechas)) + names(varTypes)<-fechas + # upd.samples$TIPO<-as.character(upd.samples$TIPO) + # upd.samples$OBS<-as.character(upd.samples$OBS) + ### !! Atención, esto cambia la base de datos: + sqlSave(dta, upd.samples, tablename="SAMPLES", append = T, varTypes = varTypes, rownames = F) + print("Tabla SAMPLES sincronizada.") + } + + ## Entradas modificadas en CLINICOS + upd.clinics<-values[["CLINICS"]] + umid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))] + rnames<-sqlFetch(dta, "CLINICS") %>% filter(OVID %in% umid.mod) %>% rownames + clinics.mod<-upd.clinics %>% filter(OVID %in% umid.mod) %>% select(-NHC) + rownames(clinics.mod)<-rnames + + ### !! Atención, esto cambia la base de datos: + print(clinics.mod) + fechas<-colnames(clinics.mod)[sqlFetch(dta, "CLINICS") %>% sapply(lubridate::is.POSIXct)] + for (i in fechas){ + clinics.mod[,i]<-lubridate::parse_date_time(clinics.mod[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date() + } varTypes<-rep("Date",length(fechas)) names(varTypes)<-fechas + print(clinics.mod) + sqlUpdate(dta, clinics.mod,"CLINICS", index="OVID") + print("Tabla CLINICS modificada.") + + ## Nuevas entradas en CLINICOS + nsamples.clin<-sqlFetch(dta, "CLINICS") %>% nrow + umid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))] + clinics.new<-upd.clinics %>% filter(OVID %in% umid.new) %>% select(-NHC) + if (length(umid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character} + + ### !! Atención, esto cambia la base de datos: + fechas<-colnames(clinics.new)[sqlFetch(dta, "CLINICS") %>% sapply(lubridate::is.POSIXct)] for (i in fechas){ - rna.sync[,i]<-lubridate::parse_date_time(rna.sync[,i], c("d/m/Y","d/m/y")) %>% as.Date() + clinics.new[,i]<-lubridate::parse_date_time(clinics.new[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date() } - sqlSave(dta, rna.sync, tablename="RNADNA", append = T, varTypes = varTypes, rownames = F) + varTypes<-rep("Date",length(fechas)) + names(varTypes)<-fechas + print(varTypes) + print(clinics.new) + sqlSave(dta, clinics.new, tablename="CLINICS", append = T, varTypes = varTypes, rownames = F) + print("Tabla CLINICS sincronizada.") } })