From ec3a8328e743f0a7a827918920f0d935c9196ef1 Mon Sep 17 00:00:00 2001 From: Costa <47926492N@ICO.SCS.local> Date: Mon, 15 Nov 2021 17:42:40 +0100 Subject: [PATCH 1/9] Adding dbtype in functions. --- sqlFunctions.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sqlFunctions.R b/sqlFunctions.R index dd14145..d697b1a 100644 --- a/sqlFunctions.R +++ b/sqlFunctions.R @@ -26,7 +26,7 @@ sqlBackUp<-function(dbfile=file,bu.dir){ file.copy(dbfile, cp_bu) } -sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F){ +sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F, dbtype){ if (isFALSE(verb)){ sqlQuery(conn, "SELECT O.NHC,S.* FROM SAMPLES S From e185a1e44d50c58ad0cc1efc7b14e012a52bb0a1 Mon Sep 17 00:00:00 2001 From: Costa <47926492N@ICO.SCS.local> Date: Tue, 16 Nov 2021 11:10:11 +0100 Subject: [PATCH 2/9] Adding dbtype to sqlShowSamples function. --- sqlFunctions.R | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/sqlFunctions.R b/sqlFunctions.R index d697b1a..a101683 100644 --- a/sqlFunctions.R +++ b/sqlFunctions.R @@ -27,17 +27,23 @@ sqlBackUp<-function(dbfile=file,bu.dir){ } sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F, dbtype){ + if (dbtype == "OV"){ + db<-c("dbtables"="SAMPLES", "dbcode"="OVID", "dbsamples"="samples") + query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"]) + } + if (dbtype == "UM"){ + db<-c("dbtables"="MUESTRAS", "dbcode"="UMID", "dbsamples"="CODIGO") + query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"]) + } + if (nrow(sqlQuery(conn, query) %>% filter(NHC %in% nhcs)) == 0){ + return("No hay muestras de ningún paciente.") + } if (isFALSE(verb)){ - sqlQuery(conn, "SELECT O.NHC,S.* - FROM SAMPLES S - INNER JOIN OVID O - ON O.OVID=S.OVID") %>% filter(NHC %in% nhcs) %>% - group_by(NHC,OVID) %>% summarise(Samples=length(samples), Names=paste0(samples, collapse = ";")) %>% merge(data.frame(NHC=nhcs),all=T) + sqlQuery(conn, query) %>% filter(NHC %in% nhcs) %>% + group_by(NHC,db["dbcode"]) %>% summarise(Samples=length(UQ(rlang::sym(db["dbsamples"]))), Names=paste0(UQ(rlang::sym(db["dbsamples"])), collapse = ";")) %>% + merge(data.frame(NHC=nhcs),all=T) %>% rename((!!db["dbcode"]):='db["dbcode"]') }else{ - sqlQuery(conn, "SELECT O.NHC,S.* - FROM SAMPLES S - INNER JOIN OVID O - ON O.OVID=S.OVID") %>% filter(NHC %in% nhcs) + sqlQuery(conn, query) %>% filter(NHC %in% nhcs) } } From 126b8c4ee2e483109a5b41749c7ea17627041a19 Mon Sep 17 00:00:00 2001 From: Costa <47926492N@ICO.SCS.local> Date: Tue, 16 Nov 2021 12:37:40 +0100 Subject: [PATCH 3/9] =?UTF-8?q?Optimizaci=C3=B3n=20de=20sqlShowSamples.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- sqlFunctions.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sqlFunctions.R b/sqlFunctions.R index a101683..32aa5f6 100644 --- a/sqlFunctions.R +++ b/sqlFunctions.R @@ -40,8 +40,8 @@ sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F, dbtype){ } if (isFALSE(verb)){ sqlQuery(conn, query) %>% filter(NHC %in% nhcs) %>% - group_by(NHC,db["dbcode"]) %>% summarise(Samples=length(UQ(rlang::sym(db["dbsamples"]))), Names=paste0(UQ(rlang::sym(db["dbsamples"])), collapse = ";")) %>% - merge(data.frame(NHC=nhcs),all=T) %>% rename((!!db["dbcode"]):='db["dbcode"]') + group_by(NHC,UQ(rlang::sym(db["dbcode"]))) %>% summarise(Samples=length(UQ(rlang::sym(db["dbsamples"]))), Names=paste0(UQ(rlang::sym(db["dbsamples"])), collapse = ";")) %>% + merge(data.frame(NHC=nhcs),all=T) %>% mutate(NHC=factor(NHC,levels = nhcs)) %>% arrange(NHC) }else{ sqlQuery(conn, query) %>% filter(NHC %in% nhcs) } From d863315655e29dc57e18db0d1a70a5c429ffbabb Mon Sep 17 00:00:00 2001 From: Costa <47926492N@ICO.SCS.local> Date: Wed, 17 Nov 2021 15:20:44 +0100 Subject: [PATCH 4/9] =?UTF-8?q?He=20creado=20la=20funci=C3=B3n=20sqlMultiS?= =?UTF-8?q?amples.=20Tambi=C3=A9n=20he=20adaptado=20la=20funci=C3=B3n=20sq?= =?UTF-8?q?lGenOVID=20para=20que=20sea=20usable=20para=20UM.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- sqlFunctions.R | 50 +++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 41 insertions(+), 9 deletions(-) diff --git a/sqlFunctions.R b/sqlFunctions.R index 32aa5f6..a5ad506 100644 --- a/sqlFunctions.R +++ b/sqlFunctions.R @@ -47,23 +47,37 @@ sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F, dbtype){ } } -sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F){ - ovid<-sqlFetch(conn,"OVID") +sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype){ + if (dbtype == "OV"){ + db<-c("dbcode"="OVID") + } + if (dbtype == "UM"){ + db<-c("dbcode"="UMID") + } + + dbid<-sqlFetch(conn,db["dbcode"]) - new.nhc<-nhcs[!nhcs %in% ovid$NHC] - next.num<-gsub("OVID","",ovid$OVID) %>% as.numeric %>% max(na.rm=T)+1 + new.nhc<-nhcs[!nhcs %in% dbid$NHC] + next.num<-gsub(db["dbcode"],"",dbid[,db["dbcode"]]) %>% as.numeric %>% max(na.rm=T)+1 last.num<-next.num+(length(new.nhc)-1) - upd.ovid<-rbind(ovid,data.frame("NHC"=new.nhc, "OVID"=sprintf("OVID%04d",next.num:last.num))) - rownames(upd.ovid)<-as.character(1:nrow(upd.ovid)) - upd.ovid<-filter(upd.ovid, NHC %in% new.nhc) %>% mutate(NHC=as.character(NHC)) + newtab<-data.frame("NHC"=new.nhc, "ID"=sprintf("%s%04d",db["dbcode"],next.num:last.num)) %>% rename(!!db["dbcode"]:="ID") + if(dbtype=="OV"){ + dbid<-rbind(dbid,newtab) + } + if(dbtype=="UM"){ + dbid<-merge(dbid, newtab, all=T) %>% select(Id,NHC,UMID) %>% arrange(Id) + dbid$Id<-rownames(dbid) + } + rownames(dbid)<-as.character(1:nrow(dbid)) + dbid<-filter(dbid, NHC %in% new.nhc) %>% mutate(NHC=as.character(NHC)) if (sinc){ ### !! Atención, esto cambia la base de datos: - sqlSave(conn, upd.ovid, tablename="OVID", append = T) + sqlSave(conn, dbid, tablename=db["dbcode"], append = T) print("La base ha sido actualizada.") } if (verb){ - return(upd.ovid) + return(dbid) } } @@ -149,3 +163,21 @@ sqlSincBD<-function(conn=dta, filetemp="QueryOV.xlsx", sinc.samples=F, sinc.clin print("Tabla CLINICS sincronizada.") } } + +sqlMultiSamples<-function(kbl=F, NHC=F){ + query<-sqlQuery(dta, "SELECT M.UMID,U.NHC,M.FECHA_RECEPCION,M.CODIGO,C.CODIGO,R.CODIGO + FROM ((MUESTRAS M + LEFT OUTER JOIN CNAG C ON M.CODIGO=C.CODIGO) + LEFT OUTER JOIN RNADNA R ON M.CODIGO=R.CODIGO) + LEFT OUTER JOIN UMID U ON U.UMID=M.UMID") %>% rename("CNAG"="CODIGO.1","RNADNA"="CODIGO.2") + + query<-query %>% mutate( + CNAG=case_when(!is.na(CNAG)~"X",TRUE~""), + RNADNA=case_when(!is.na(RNADNA)~"X",TRUE~"") + ) + if (kbl==T){ + query %>% kableExtra::kbl() %>% kableExtra::kable_styling(full_width = F, bootstrap_options = c("striped")) + }else{ + return(query) + } +} From 39c9f9bcc49dcaf41f49ee2a206c7efca194e7bf Mon Sep 17 00:00:00 2001 From: Costa <47926492N@ICO.SCS.local> Date: Wed, 17 Nov 2021 15:21:48 +0100 Subject: [PATCH 5/9] He puesto el sqlInitizalize antes del sqlBackup. --- workflow.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/workflow.R b/workflow.R index 888502d..859789d 100644 --- a/workflow.R +++ b/workflow.R @@ -3,12 +3,12 @@ source("sqlFunctions.R") ## Asegurarse de que la variable file sea la que nos corresponde: file -# Crear copia de seguridad -sqlBackUp(bu.dir="BU_OVARIO") - # Cargar dependencias sqlInitialize() +# Crear copia de seguridad +sqlBackUp(bu.dir="BU_OVARIO") + # Inicializar conexión dta<-odbcConnectAccess2007(access.file = file, pwd = .rs.askForPassword("Enter password:")) From a87460b6bb89823fe20d263f07a4936f2bff3256 Mon Sep 17 00:00:00 2001 From: Costa <47926492N@ICO.SCS.local> Date: Mon, 20 Dec 2021 15:20:11 +0100 Subject: [PATCH 6/9] Completar compatibilidad con MU. --- sqlFunctions.R | 277 +++++++++++++++++++++++++++++++++++-------------- workflow.R | 10 +- 2 files changed, 203 insertions(+), 84 deletions(-) diff --git a/sqlFunctions.R b/sqlFunctions.R index a5ad506..a0b91fb 100644 --- a/sqlFunctions.R +++ b/sqlFunctions.R @@ -1,9 +1,16 @@ require(RODBC) -sqlDropLast<-function(conn, tablename, droplast=1){ +sqlDropLast<-function(conn, tablename, droplast=1,dbtype=NULL){ + if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} + if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} + table<-sqlFetch(conn, tablename) table<-table[1:(nrow(table)-droplast),] - sqlSave(conn, table, tablename = tablename, safer = F) + + if (dbtype == "OV"){sqlSave(conn, table, tablename = tablename, safer = F)} + if (dbtype == "UM"){ + sqlDrop(conn, tablename) + sqlSave(conn, table, tablename = tablename, safer = F)} } sqlInitialize<-function(){ @@ -15,7 +22,10 @@ sqlInitialize<-function(){ source("ruta_database.R", encoding = "UTF-8") } -sqlBackUp<-function(dbfile=file,bu.dir){ +sqlBackUp<-function(dbfile=file,conn=dta,bu.dir=NULL){ + if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){bu.dir<-"BU_UM"} + if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"BU_OVARIO"} + db=strsplit(dbfile, "/")[[1]]%>% tail(n=1) bu_path<-gsub(db,bu.dir,dbfile) if (!dir.exists(bu_path)){ @@ -26,7 +36,10 @@ sqlBackUp<-function(dbfile=file,bu.dir){ file.copy(dbfile, cp_bu) } -sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F, dbtype){ +sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F, dbtype=NULL){ + if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} + if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} + if (dbtype == "OV"){ db<-c("dbtables"="SAMPLES", "dbcode"="OVID", "dbsamples"="samples") query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"]) @@ -47,7 +60,10 @@ sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F, dbtype){ } } -sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype){ +sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL){ + if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} + if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} + if (dbtype == "OV"){ db<-c("dbcode"="OVID") } @@ -66,7 +82,8 @@ sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype){ } if(dbtype=="UM"){ dbid<-merge(dbid, newtab, all=T) %>% select(Id,NHC,UMID) %>% arrange(Id) - dbid$Id<-rownames(dbid) + dbid$Id<-as.numeric(rownames(dbid)) + dbid$NHC<-as.numeric(dbid$NHC) } rownames(dbid)<-as.character(1:nrow(dbid)) dbid<-filter(dbid, NHC %in% new.nhc) %>% mutate(NHC=as.character(NHC)) @@ -81,100 +98,202 @@ sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype){ } } -sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T){ - upd.ovid<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs) - if (samples.mod){ - ## Generar código para las nuevas muestras - samples<-sqlFetch(conn, "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 +sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T, dbtype=NULL){ + if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} + if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} + + if (dbtype=="OV"){ + upd.ovid<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs) + if (samples.mod){ + ## Generar código para las nuevas muestras + samples<-sqlFetch(conn, "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 + } + last.samp<-next.samp+(length(nhcs)-1) + new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp) + new.samp.df<-merge(sqlFetch(dta,"OVID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "samples"=new.samp)) + samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples) + } + + if (clinics.mod){ + ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos + upd.clinics<-sqlFetch(conn, "CLINICS") + ovid.new<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs) + upd.clinics<-merge(ovid.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])} } - last.samp<-next.samp+(length(nhcs)-1) - new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp) - new.samp.df<-merge(sqlFetch(dta,"OVID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "samples"=new.samp)) - samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples) - } - if (clinics.mod){ - ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos - upd.clinics<-sqlFetch(conn, "CLINICS") - ovid.new<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs) - upd.clinics<-merge(ovid.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])} + ## Exportar tablas a la plantilla de entrada para su rellenado + wb <- loadWorkbook(file) + writeData(wb, "NHC", upd.ovid) + if (samples.mod){writeData(wb,"samples",samples.exp)} + if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)} + saveWorkbook(wb,file,overwrite = TRUE) + } + if (dbtype=="UM"){ + upd.umid<-sqlFetch(conn, "UMID") %>% filter(NHC %in% nhcs) + if (samples.mod){ + ## Generar código para las nuevas muestras + samples<-sqlFetch(conn, "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(nhcs)-1) + new.samp<-sprintf("UM%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp) + new.samp.df<-merge(sqlFetch(dta,"UMID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "CODIGO"=new.samp)) + samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO) + } + + if (clinics.mod){ + ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos + upd.clinics<-sqlFetch(conn, "CLINICOS") + umid.new<-sqlFetch(conn, "UMID") %>% filter(NHC %in% nhcs) + upd.clinics<-merge(umid.new,upd.clinics %>% select(-Id), 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])} + } + + ## Exportar tablas a la plantilla de entrada para su rellenado + wb <- loadWorkbook(file) + writeData(wb, "NHC", upd.umid) + if (samples.mod){writeData(wb,"samples",samples.exp)} + if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)} + saveWorkbook(wb,file,overwrite = TRUE) } - - ## Exportar tablas a la plantilla de entrada para su rellenado - wb <- loadWorkbook(file) - writeData(wb, "NHC", upd.ovid) - if (samples.mod){writeData(wb,"samples",samples.exp)} - if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)} - saveWorkbook(wb,file,overwrite = TRUE) } -sqlSincBD<-function(conn=dta, filetemp="QueryOV.xlsx", sinc.samples=F, sinc.clinics=F){ - ## Añadir código de muestra nueva a la base de datos - nsamples<-sqlFetch(conn, "SAMPLES") %>% nrow - upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T) - if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character} +sqlSincBD<-function(conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clinics=F, dbtype=NULL){ + if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} + if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} - if (sinc.samples & nrow(upd.samples) > 0){ - upd.samples$IQ_date<-as.Date(upd.samples$IQ_date) - upd.samples$TIL_date<-as.Date(upd.samples$TIL_date) - ### !! Atención, esto cambia la base de datos: - sqlSave(conn, upd.samples, tablename="SAMPLES", append = T, varTypes = c("IQ_date"="date","TIL_date"="date")) - print("Tabla SAMPLES sincronizada.") + ## Añadir código de muestra nueva a la base de datos + if (dbtype == "OV"){ + print("DB OV detectada") + nsamples<-sqlFetch(conn, "SAMPLES") %>% nrow + upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T) + if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character} + + if (sinc.samples & nrow(upd.samples) > 0){ + upd.samples$IQ_date<-as.Date(upd.samples$IQ_date) + upd.samples$TIL_date<-as.Date(upd.samples$TIL_date) + ### !! Atención, esto cambia la base de datos: + sqlSave(conn, upd.samples, tablename="SAMPLES", append = T, varTypes = c("IQ_date"="date","TIL_date"="date")) + print("Tabla SAMPLES sincronizada.") + } + } + if (dbtype == "UM"){ + print("DB UM detectada") + nsamples<-sqlFetch(conn, "MUESTRAS") %>% nrow + upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T) + if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character} + + if (sinc.samples & nrow(upd.samples) > 0){ + upd.samples$FECHA_RECEPCION<-as.Date(upd.samples$FECHA_RECEPCION) + 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(conn, upd.samples, tablename="MUESTRAS", append = T, varTypes = c("FECHA_RECEPCION"="Date"), rownames = F) + print("Tabla MUESTRAS sincronizada.") + } } ## Añadir datos clínicos modificados a la base de datos - upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T) - ovid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))] - rnames<-sqlFetch(conn, "CLINICS") %>% filter(OVID %in% ovid.mod) %>% rownames - clinics.mod<-upd.clinics %>% filter(OVID %in% ovid.mod) %>% select(-NHC) - rownames(clinics.mod)<-rnames - - ### !! Atención, esto cambia la base de datos: - if (sinc.clinics){ - fechas<-colnames(clinics.mod)[grepl("DO|date", colnames(clinics.mod))] - for (i in fechas){ - clinics.mod[,i]<-as.Date(clinics.mod[,i]) + if (dbtype == "OV"){ + upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T) + ovid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))] + rnames<-sqlFetch(conn, "CLINICS") %>% filter(OVID %in% ovid.mod) %>% rownames + clinics.mod<-upd.clinics %>% filter(OVID %in% ovid.mod) %>% select(-NHC) + rownames(clinics.mod)<-rnames + + ### !! Atención, esto cambia la base de datos: + if (sinc.clinics){ + fechas<-colnames(clinics.mod)[grepl("DO|date", colnames(clinics.mod))] + for (i in fechas){ + clinics.mod[,i]<-as.Date(clinics.mod[,i]) + } + sqlUpdate(conn, clinics.mod,"CLINICS") + print("Tabla CLINICS modificada.") + } + } + if (dbtype == "UM"){ + upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T) + umid.mod<-upd.clinics$UMID[upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))] + rnames<-sqlFetch(conn, "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: + if (sinc.clinics){ + fechas<-colnames(clinics.mod)[grepl("date|MET_DX|DoB", colnames(clinics.mod), ignore.case = T)] + for (i in fechas){ + clinics.mod[,i]<-as.Date(clinics.mod[,i]) + } + sqlUpdate(conn, clinics.mod,"CLINICOS") + print("Tabla CLINICOS modificada.") } - sqlUpdate(conn, clinics.mod,"CLINICS") - print("Tabla CLINICS modificada.") } ## Añadir datos clínicos nuevos a la base de datos - nsamples.clin<-sqlFetch(conn, "CLINICS") %>% nrow - ovid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(conn, "CLINICS") %>% pull(OVID))] - clinics.new<-upd.clinics %>% filter(OVID %in% ovid.new) %>% select(-NHC) - if (length(ovid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character} - - ### !! Atención, esto cambia la base de datos: - if (sinc.clinics){ - fechas<-colnames(clinics.new)[grepl("DO|date", colnames(clinics.new))] - varTypes<-rep("Date",length(fechas)) - names(varTypes)<-fechas - for (i in fechas){ - clinics.new[,i]<-as.Date(clinics.new[,i]) + if (dbtype == "OV"){ + nsamples.clin<-sqlFetch(conn, "CLINICS") %>% nrow + ovid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(conn, "CLINICS") %>% pull(OVID))] + clinics.new<-upd.clinics %>% filter(OVID %in% ovid.new) %>% select(-NHC) + if (length(ovid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character} + + ### !! Atención, esto cambia la base de datos: + if (sinc.clinics){ + fechas<-colnames(clinics.new)[grepl("DO|date", colnames(clinics.new))] + varTypes<-rep("Date",length(fechas)) + names(varTypes)<-fechas + for (i in fechas){ + clinics.new[,i]<-as.Date(clinics.new[,i]) + } + sqlSave(conn, clinics.new, tablename="CLINICS", append = T, varTypes = varTypes) + print("Tabla CLINICS sincronizada.") + } + } + if (dbtype == "UM"){ + nsamples.clin<-sqlFetch(conn, "CLINICOS") %>% nrow + umid.new<-upd.clinics$UMID[!upd.clinics$UMID %in% (sqlFetch(conn, "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: + if (sinc.clinics){ + 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]<-as.Date(clinics.new[,i]) + } + sqlSave(conn, clinics.new, tablename="CLINICOS", append = T, varTypes = varTypes) + print("Tabla CLINICOS sincronizada.") } - sqlSave(conn, clinics.new, tablename="CLINICS", append = T, varTypes = varTypes) - print("Tabla CLINICS sincronizada.") } } -sqlMultiSamples<-function(kbl=F, NHC=F){ - query<-sqlQuery(dta, "SELECT M.UMID,U.NHC,M.FECHA_RECEPCION,M.CODIGO,C.CODIGO,R.CODIGO - FROM ((MUESTRAS M +sqlMultiSamples<-function(kbl=F, NHC=F, full=F){ + query<-sqlQuery(dta, "SELECT U.UMID,U.NHC,M.FECHA_RECEPCION,M.TIPO,M.CODIGO,C.CODIGO,R.CODIGO,R.ESTADO + FROM ((UMID U + LEFT OUTER JOIN MUESTRAS M ON U.UMID=M.UMID) LEFT OUTER JOIN CNAG C ON M.CODIGO=C.CODIGO) - LEFT OUTER JOIN RNADNA R ON M.CODIGO=R.CODIGO) - LEFT OUTER JOIN UMID U ON U.UMID=M.UMID") %>% rename("CNAG"="CODIGO.1","RNADNA"="CODIGO.2") + LEFT OUTER JOIN RNADNA R ON M.CODIGO=R.CODIGO") %>% rename("CNAG"="CODIGO.1","RNADNA"="CODIGO.2") + + if (full==F){query<- query %>% filter(!is.na(CODIGO))} + if (NHC==F){query<- query %>% select(-NHC)} query<-query %>% mutate( CNAG=case_when(!is.na(CNAG)~"X",TRUE~""), - RNADNA=case_when(!is.na(RNADNA)~"X",TRUE~"") - ) + RNADNA=case_when((!is.na(RNADNA) & (ESTADO=="ENV"))~"X", + (!is.na(RNADNA) & (is.na(ESTADO)))~".", + TRUE~"") + ) %>% select(-ESTADO) if (kbl==T){ query %>% kableExtra::kbl() %>% kableExtra::kable_styling(full_width = F, bootstrap_options = c("striped")) }else{ diff --git a/workflow.R b/workflow.R index 859789d..c474b60 100644 --- a/workflow.R +++ b/workflow.R @@ -1,13 +1,13 @@ -source("sqlFunctions.R") - -## Asegurarse de que la variable file sea la que nos corresponde: -file +source("sqlFunctions.R", encoding = "UTF-8") # Cargar dependencias sqlInitialize() +## Asegurarse de que la variable file sea la que nos corresponde: +file + # Crear copia de seguridad -sqlBackUp(bu.dir="BU_OVARIO") +sqlBackUp() # Inicializar conexión dta<-odbcConnectAccess2007(access.file = file, From 944b5df18109dc6b048f0cc8fc34f3e9df970347 Mon Sep 17 00:00:00 2001 From: Costa <47926492N@ICO.SCS.local> Date: Mon, 20 Dec 2021 16:08:10 +0100 Subject: [PATCH 7/9] Updating documentation. --- Docs/Readme.md | 395 ++++++++++++++++++++++++-------- Docs/sqlFunctions-doc.Rmd | 394 ++++++++++++++++++++++++-------- Docs/sqlFunctions-doc.html | 447 +++++++++++++++++++++++++++++-------- 3 files changed, 940 insertions(+), 296 deletions(-) diff --git a/Docs/Readme.md b/Docs/Readme.md index 4fff343..e264a6e 100644 --- a/Docs/Readme.md +++ b/Docs/Readme.md @@ -8,6 +8,7 @@
  • sqlGenOVID
  • sqlWriteTemp
  • sqlSincBD
  • +
  • sqlMultiSamples
  • @@ -19,7 +20,7 @@ Removes from Database the last (or the amount specified) entry. ### Usage -sqlDropLast(conn, tablename, droplast=1) +sqlDropLast(conn, tablename, droplast=1, dbtype=NULL) ### Arguments Argument|Description @@ -27,6 +28,7 @@ Argument|Description conn|connection handle returned by odbcConnect. tablename|character: a database table name accessible from the connected DSN. droplast|the amount of lines to be removed from the table strating from tail. By default, it removes only 1 line. +dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced. ### Details Removes from Database the last (or the amount specified) entry. @@ -42,10 +44,17 @@ sqlDropLast(dta, "TableTest") ### Function ```r -sqlDropLast<-function(conn, tablename, droplast=1){ +sqlDropLast<-function(conn, tablename, droplast=1,dbtype=NULL){ + if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} + if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} + table<-sqlFetch(conn, tablename) table<-table[1:(nrow(table)-droplast),] - sqlSave(conn, table, tablename = tablename, safer = F) + + if (dbtype == "OV"){sqlSave(conn, table, tablename = tablename, safer = F)} + if (dbtype == "UM"){ + sqlDrop(conn, tablename) + sqlSave(conn, table, tablename = tablename, safer = F)} } ``` @@ -94,13 +103,14 @@ sqlInitialize<-function(){ Creates a Back Up copy of the database. ### Usage -sqlBackUp(dbfile=file,bu.dir="BU_OVARIO") +sqlBackUp(dbfile=file,conn=dta,bu.dir=NULL) ### Arguments Argument|Description ---|--- dbfile| Database File location. -bu.dir| Directory under the DB file where the back up will be placed. +conn|connection handle returned by odbcConnect. +bu.dir|Directory under the DB file where the back up will be placed. It defaults to NULL and is deduced from conn database. ### Details Creates a Back Up copy of the database. It adds the date in front of the back up file. @@ -116,7 +126,10 @@ sqlBackUp() ### Function ```r -sqlBackUp<-function(dbfile=file,bu.dir="BU_OVARIO"){ +sqlBackUp<-function(dbfile=file,conn=dta,bu.dir=NULL){ + if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){bu.dir<-"BU_UM"} + if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"BU_OVARIO"} + db=strsplit(dbfile, "/")[[1]]%>% tail(n=1) bu_path<-gsub(db,bu.dir,dbfile) if (!dir.exists(bu_path)){ @@ -136,7 +149,7 @@ sqlBackUp<-function(dbfile=file,bu.dir="BU_OVARIO"){ Shows if there are already samples from the specified NHCs. ### Usage -sqlShowSamples(conn=dta, nhcs=nhc.test, verb=F) +sqlShowSamples(conn=dta, nhcs=nhc.test, verb=F, dbtype=NULL) ### Arguments Argument|Description @@ -144,6 +157,7 @@ Argument|Description conn|connection handle returned by odbcConnect. nhcs|Character vector with the NHCs to test. verb|Verbose: if TRUE, all the columns from "SAMPLES" table are printed. +dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced. ### Details Takes the NHCs listed in the nhcs vector and checks if there are already samples from those patients. @@ -160,18 +174,27 @@ sqlShowSamples() ### Function ```r -sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F){ +sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F, dbtype=NULL){ + if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} + if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} + + if (dbtype == "OV"){ + db<-c("dbtables"="SAMPLES", "dbcode"="OVID", "dbsamples"="samples") + query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"]) + } + if (dbtype == "UM"){ + db<-c("dbtables"="MUESTRAS", "dbcode"="UMID", "dbsamples"="CODIGO") + query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"]) + } + if (nrow(sqlQuery(conn, query) %>% filter(NHC %in% nhcs)) == 0){ + return("No hay muestras de ningún paciente.") + } if (isFALSE(verb)){ - sqlQuery(conn, "SELECT O.NHC,S.* - FROM SAMPLES S - INNER JOIN OVID O - ON O.OVID=S.OVID") %>% filter(NHC %in% nhcs) %>% - group_by(NHC,OVID) %>% summarise(Samples=length(samples), Names=paste0(samples, collapse = ";")) %>% merge(data.frame(NHC=nhcs),all=T) + sqlQuery(conn, query) %>% filter(NHC %in% nhcs) %>% + group_by(NHC,UQ(rlang::sym(db["dbcode"]))) %>% summarise(Samples=length(UQ(rlang::sym(db["dbsamples"]))), Names=paste0(UQ(rlang::sym(db["dbsamples"])), collapse = ";")) %>% + merge(data.frame(NHC=nhcs),all=T) %>% mutate(NHC=factor(NHC,levels = nhcs)) %>% arrange(NHC) }else{ - sqlQuery(conn, "SELECT O.NHC,S.* - FROM SAMPLES S - INNER JOIN OVID O - ON O.OVID=S.OVID") %>% filter(NHC %in% nhcs) + sqlQuery(conn, query) %>% filter(NHC %in% nhcs) } } ``` @@ -181,10 +204,10 @@ sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F){ ## sqlGenOVID ### Description -Generates new consecutive OVID code for the patients that are not found in the DB. +Generates new consecutive OVID or UMID code for the patients that are not found in the DB. ### Usage -sqlGenOVID(conn=dta, nhcs=nhc.test, verb=T, sinc=F) +sqlGenOVID(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL) ### Arguments Argument|Description @@ -193,9 +216,10 @@ conn|connection handle returned by odbcConnect. nhcs|Character vector with the NHCs to test. verb|Verbose: if TRUE (default), it prints the data.frame with the generated OVID codes. sinc|If TRUE (default is FALSE for security), it adds the new entries to the "OVID" table in the DB. +dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced. ### Details -Generates new consecutive OVID code for the patients that are not found in the DB. +Generates new consecutive OVID or UMID code for the patients that are not found in the DB. ### Value If verb is TRUE, it returns a data.frame. @@ -209,23 +233,41 @@ sqlGenOVID(sinc=T) ### Function ```r -sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F){ - ovid<-sqlFetch(conn,"OVID") +sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL){ + if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} + if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} - new.nhc<-nhcs[!nhcs %in% ovid$NHC] - next.num<-gsub("OVID","",ovid$OVID) %>% as.numeric %>% max(na.rm=T)+1 + if (dbtype == "OV"){ + db<-c("dbcode"="OVID") + } + if (dbtype == "UM"){ + db<-c("dbcode"="UMID") + } + + dbid<-sqlFetch(conn,db["dbcode"]) + + new.nhc<-nhcs[!nhcs %in% dbid$NHC] + next.num<-gsub(db["dbcode"],"",dbid[,db["dbcode"]]) %>% as.numeric %>% max(na.rm=T)+1 last.num<-next.num+(length(new.nhc)-1) - upd.ovid<-rbind(ovid,data.frame("NHC"=new.nhc, "OVID"=sprintf("OVID%04d",next.num:last.num))) - rownames(upd.ovid)<-as.character(1:nrow(upd.ovid)) - upd.ovid<-filter(upd.ovid, NHC %in% new.nhc) %>% mutate(NHC=as.character(NHC)) + newtab<-data.frame("NHC"=new.nhc, "ID"=sprintf("%s%04d",db["dbcode"],next.num:last.num)) %>% rename(!!db["dbcode"]:="ID") + if(dbtype=="OV"){ + dbid<-rbind(dbid,newtab) + } + if(dbtype=="UM"){ + dbid<-merge(dbid, newtab, all=T) %>% select(Id,NHC,UMID) %>% arrange(Id) + dbid$Id<-as.numeric(rownames(dbid)) + dbid$NHC<-as.numeric(dbid$NHC) + } + rownames(dbid)<-as.character(1:nrow(dbid)) + dbid<-filter(dbid, NHC %in% new.nhc) %>% mutate(NHC=as.character(NHC)) if (sinc){ ### !! Atención, esto cambia la base de datos: - sqlSave(conn, upd.ovid, tablename="OVID", append = T) + sqlSave(conn, dbid, tablename=db["dbcode"], append = T) print("La base ha sido actualizada.") } if (verb){ - return(upd.ovid) + return(dbid) } } ``` @@ -235,10 +277,10 @@ sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F){ ## sqlWriteTemp ### Description -Fills the Query Template file with the OVID and OV newly generated codes. +Fills the Query Template file with the OVID or UMID and OV or UM newly generated codes. ### Usage -sqlWriteTemp(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T) +sqlWriteTemp(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T, dbtype=NULL) ### Arguments Argument|Description @@ -248,9 +290,10 @@ nhcs|Character vector with the NHCs to test. file|Template file that will be used to interact with the DB. samples.mod|If TRUE (default), it fills the "samples" template sheet. clinics.mod|If TRUE (default), it fills the "CLINICS" template sheet. +dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced. ### Details -Fills the Query Template file with the OVID and OV newly generated codes. It is required that the DB has been updated with the sqlGenOVID function. It replaces previous content in the template file sheets that are filled. In the case of "CLINICS" table, if there were already an entry in the DB for that OVID code, the template file is filled with that information. +Fills the Query Template file with the OVID and OV or UMID and UM newly generated codes. It is required that the DB has been updated with the sqlGenOVID function. It replaces previous content in the template file sheets that are filled. In the case of "CLINICS" table, if there were already an entry in the DB for that OVID/UMID code, the template file is filled with that information. ### Value Invisibly for success (and failures cause errors). @@ -265,37 +308,74 @@ sqlWriteTemp() ### Function ```r -sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T){ - upd.ovid<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs) - if (samples.mod){ - ## Generar código para las nuevas muestras - samples<-sqlFetch(conn, "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 +sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T, dbtype=NULL){ + if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} + if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} + + if (dbtype=="OV"){ + upd.ovid<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs) + if (samples.mod){ + ## Generar código para las nuevas muestras + samples<-sqlFetch(conn, "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 + } + last.samp<-next.samp+(length(nhcs)-1) + new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp) + new.samp.df<-merge(sqlFetch(dta,"OVID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "samples"=new.samp)) + samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples) + } + + if (clinics.mod){ + ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos + upd.clinics<-sqlFetch(conn, "CLINICS") + ovid.new<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs) + upd.clinics<-merge(ovid.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])} } - last.samp<-next.samp+(length(nhcs)-1) - new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp) - new.samp.df<-merge(sqlFetch(dta,"OVID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "samples"=new.samp)) - samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples) - } - if (clinics.mod){ - ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos - upd.clinics<-sqlFetch(conn, "CLINICS") - ovid.new<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs) - upd.clinics<-merge(ovid.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])} + ## Exportar tablas a la plantilla de entrada para su rellenado + wb <- loadWorkbook(file) + writeData(wb, "NHC", upd.ovid) + if (samples.mod){writeData(wb,"samples",samples.exp)} + if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)} + saveWorkbook(wb,file,overwrite = TRUE) + } + if (dbtype=="UM"){ + upd.umid<-sqlFetch(conn, "UMID") %>% filter(NHC %in% nhcs) + if (samples.mod){ + ## Generar código para las nuevas muestras + samples<-sqlFetch(conn, "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(nhcs)-1) + new.samp<-sprintf("UM%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp) + new.samp.df<-merge(sqlFetch(dta,"UMID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "CODIGO"=new.samp)) + samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO) + } + + if (clinics.mod){ + ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos + upd.clinics<-sqlFetch(conn, "CLINICOS") + umid.new<-sqlFetch(conn, "UMID") %>% filter(NHC %in% nhcs) + upd.clinics<-merge(umid.new,upd.clinics %>% select(-Id), 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])} + } + + ## Exportar tablas a la plantilla de entrada para su rellenado + wb <- loadWorkbook(file) + writeData(wb, "NHC", upd.umid) + if (samples.mod){writeData(wb,"samples",samples.exp)} + if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)} + saveWorkbook(wb,file,overwrite = TRUE) } - - ## Exportar tablas a la plantilla de entrada para su rellenado - wb <- loadWorkbook(file) - writeData(wb, "NHC", upd.ovid) - if (samples.mod){writeData(wb,"samples",samples.exp)} - if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)} - saveWorkbook(wb,file,overwrite = TRUE) } ``` @@ -307,7 +387,7 @@ sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod Updates the DB with the information filled in the template file. ### Usage -sqlSincBD(conn=dta, filetemp="QueryOV.xlsx", sinc.samples=F, sinc.clinics=F) +sqlSincBD(conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clinics=F, dbtype=NULL) ### Arguments Argument|Description @@ -316,6 +396,7 @@ conn|connection handle returned by odbcConnect. filetemp|Template file that will be used to interact with the DB. sinc.samples|If TRUE (default is FALSE for security), it updates the SAMPLES table in the DB with the information in the "samples" template sheet. clinics.mod|If TRUE (default is FALSE for security), it updates the CLINICS table in the DB with the information in the "CLINICS" template sheet. +dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced. ### Details Updates the DB with the information filled in the template file. All the "samples" entries are added as new rows (as all samples are new even if the patient was already in the DB). The new patients included in the "CLINICS" sheet are introduced in the DB as new rows and the ones that were already there are modified in its previous row location. @@ -334,52 +415,168 @@ sqlSincBD(sinc.samples=T, sinc.clinics=T) ### Function ```r -sqlSincBD<-function(conn=dta, filetemp="QueryOV.xlsx", sinc.samples=F, sinc.clinics=F){ - ## Añadir código de muestra nueva a la base de datos - nsamples<-sqlFetch(conn, "SAMPLES") %>% nrow - upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T) - if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character} +sqlSincBD<-function(conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clinics=F, dbtype=NULL){ + if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} + if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} - if (sinc.samples & nrow(upd.samples) > 0){ - upd.samples$IQ_date<-as.Date(upd.samples$IQ_date) - ### !! Atención, esto cambia la base de datos: - sqlSave(conn, upd.samples, tablename="SAMPLES", append = T, varTypes = c("IQ_date"="date")) - print("Tabla SAMPLES sincronizada.") + ## Añadir código de muestra nueva a la base de datos + if (dbtype == "OV"){ + print("DB OV detectada") + nsamples<-sqlFetch(conn, "SAMPLES") %>% nrow + upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T) + if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character} + + if (sinc.samples & nrow(upd.samples) > 0){ + upd.samples$IQ_date<-as.Date(upd.samples$IQ_date) + upd.samples$TIL_date<-as.Date(upd.samples$TIL_date) + ### !! Atención, esto cambia la base de datos: + sqlSave(conn, upd.samples, tablename="SAMPLES", append = T, varTypes = c("IQ_date"="date","TIL_date"="date")) + print("Tabla SAMPLES sincronizada.") + } + } + if (dbtype == "UM"){ + print("DB UM detectada") + nsamples<-sqlFetch(conn, "MUESTRAS") %>% nrow + upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T) + if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character} + + if (sinc.samples & nrow(upd.samples) > 0){ + upd.samples$FECHA_RECEPCION<-as.Date(upd.samples$FECHA_RECEPCION) + 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(conn, upd.samples, tablename="MUESTRAS", append = T, varTypes = c("FECHA_RECEPCION"="Date"), rownames = F) + print("Tabla MUESTRAS sincronizada.") + } } ## Añadir datos clínicos modificados a la base de datos - upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T) - ovid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))] - rnames<-sqlFetch(conn, "CLINICS") %>% filter(OVID %in% ovid.mod) %>% rownames - clinics.mod<-upd.clinics %>% filter(OVID %in% ovid.mod) %>% select(-NHC) - rownames(clinics.mod)<-rnames - - ### !! Atención, esto cambia la base de datos: - if (sinc.clinics){ - fechas<-colnames(clinics.mod)[grepl("DO|date", colnames(clinics.mod))] - for (i in fechas){ - clinics.mod[,i]<-as.Date(clinics.mod[,i]) + if (dbtype == "OV"){ + upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T) + ovid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))] + rnames<-sqlFetch(conn, "CLINICS") %>% filter(OVID %in% ovid.mod) %>% rownames + clinics.mod<-upd.clinics %>% filter(OVID %in% ovid.mod) %>% select(-NHC) + rownames(clinics.mod)<-rnames + + ### !! Atención, esto cambia la base de datos: + if (sinc.clinics){ + fechas<-colnames(clinics.mod)[grepl("DO|date", colnames(clinics.mod))] + for (i in fechas){ + clinics.mod[,i]<-as.Date(clinics.mod[,i]) + } + sqlUpdate(conn, clinics.mod,"CLINICS") + print("Tabla CLINICS modificada.") + } + } + if (dbtype == "UM"){ + upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T) + umid.mod<-upd.clinics$UMID[upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))] + rnames<-sqlFetch(conn, "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: + if (sinc.clinics){ + fechas<-colnames(clinics.mod)[grepl("date|MET_DX|DoB", colnames(clinics.mod), ignore.case = T)] + for (i in fechas){ + clinics.mod[,i]<-as.Date(clinics.mod[,i]) + } + sqlUpdate(conn, clinics.mod,"CLINICOS") + print("Tabla CLINICOS modificada.") } - sqlUpdate(conn, clinics.mod,"CLINICS") - print("Tabla CLINICS modificada.") } ## Añadir datos clínicos nuevos a la base de datos - nsamples.clin<-sqlFetch(conn, "CLINICS") %>% nrow - ovid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(conn, "CLINICS") %>% pull(OVID))] - clinics.new<-upd.clinics %>% filter(OVID %in% ovid.new) %>% select(-NHC) - if (length(ovid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character} - - ### !! Atención, esto cambia la base de datos: - if (sinc.clinics){ - fechas<-colnames(clinics.new)[grepl("DO|date", colnames(clinics.new))] - varTypes<-rep("Date",length(fechas)) - names(varTypes)<-fechas - for (i in fechas){ - clinics.new[,i]<-as.Date(clinics.new[,i]) + if (dbtype == "OV"){ + nsamples.clin<-sqlFetch(conn, "CLINICS") %>% nrow + ovid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(conn, "CLINICS") %>% pull(OVID))] + clinics.new<-upd.clinics %>% filter(OVID %in% ovid.new) %>% select(-NHC) + if (length(ovid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character} + + ### !! Atención, esto cambia la base de datos: + if (sinc.clinics){ + fechas<-colnames(clinics.new)[grepl("DO|date", colnames(clinics.new))] + varTypes<-rep("Date",length(fechas)) + names(varTypes)<-fechas + for (i in fechas){ + clinics.new[,i]<-as.Date(clinics.new[,i]) + } + sqlSave(conn, clinics.new, tablename="CLINICS", append = T, varTypes = varTypes) + print("Tabla CLINICS sincronizada.") + } + } + if (dbtype == "UM"){ + nsamples.clin<-sqlFetch(conn, "CLINICOS") %>% nrow + umid.new<-upd.clinics$UMID[!upd.clinics$UMID %in% (sqlFetch(conn, "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: + if (sinc.clinics){ + 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]<-as.Date(clinics.new[,i]) + } + sqlSave(conn, clinics.new, tablename="CLINICOS", append = T, varTypes = varTypes) + print("Tabla CLINICOS sincronizada.") } - sqlSave(conn, clinics.new, tablename="CLINICS", append = T, varTypes = varTypes) - print("Tabla CLINICS sincronizada.") } } -``` \ No newline at end of file +``` + +--- + +## sqlMultiSamples + +### Description +Prints a table compiling information about laboratory samples, scRNAseq samples and RNA/DNA samples. + +### Usage +sqlMultiSamples(kbl=F, NHC=F, full=F) + +### Arguments +Argument|Description +---|--- +kbl|formats the output table with the kableEstra style. Defaults to F. +NHC|adds the NHC to the table in addition to the UMID. Defaults to F. +full|prints also the patients that doesn't appear in the MUESTRAS table. Defaults to F. + +### Details +Prints a table compiling information about laboratory samples, scRNAseq samples and RNA/DNA samples. + +### Value +A data.frame or a kableExtra table. + +### Examples +```r +dta<-odbcConnect("test") +sqlMultiSamples() +``` + +### Function +```r +sqlMultiSamples<-function(kbl=F, NHC=F, full=F){ + query<-sqlQuery(dta, "SELECT U.UMID,U.NHC,M.FECHA_RECEPCION,M.TIPO,M.CODIGO,C.CODIGO,R.CODIGO,R.ESTADO + FROM ((UMID U + LEFT OUTER JOIN MUESTRAS M ON U.UMID=M.UMID) + LEFT OUTER JOIN CNAG C ON M.CODIGO=C.CODIGO) + LEFT OUTER JOIN RNADNA R ON M.CODIGO=R.CODIGO") %>% rename("CNAG"="CODIGO.1","RNADNA"="CODIGO.2") + + if (full==F){query<- query %>% filter(!is.na(CODIGO))} + if (NHC==F){query<- query %>% select(-NHC)} + + query<-query %>% mutate( + CNAG=case_when(!is.na(CNAG)~"X",TRUE~""), + RNADNA=case_when((!is.na(RNADNA) & (ESTADO=="ENV"))~"X", + (!is.na(RNADNA) & (is.na(ESTADO)))~".", + TRUE~"") + ) %>% select(-ESTADO) + if (kbl==T){ + query %>% kableExtra::kbl() %>% kableExtra::kable_styling(full_width = F, bootstrap_options = c("striped")) + }else{ + return(query) + } +} +``` diff --git a/Docs/sqlFunctions-doc.Rmd b/Docs/sqlFunctions-doc.Rmd index 0929061..5f00f51 100644 --- a/Docs/sqlFunctions-doc.Rmd +++ b/Docs/sqlFunctions-doc.Rmd @@ -18,7 +18,7 @@ knitr::opts_chunk$set(echo = TRUE) Removes from Database the last (or the amount specified) entry. ### Usage -sqlDropLast(conn, tablename, droplast=1) +sqlDropLast(conn, tablename, droplast=1, dbtype=NULL) ### Arguments Argument|Description @@ -26,6 +26,7 @@ Argument|Description conn|connection handle returned by odbcConnect. tablename|character: a database table name accessible from the connected DSN. droplast|the amount of lines to be removed from the table strating from tail. By default, it removes only 1 line. +dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced. ### Details Removes from Database the last (or the amount specified) entry. @@ -41,10 +42,17 @@ sqlDropLast(dta, "TableTest") ### Function ```r -sqlDropLast<-function(conn, tablename, droplast=1){ +sqlDropLast<-function(conn, tablename, droplast=1,dbtype=NULL){ + if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} + if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} + table<-sqlFetch(conn, tablename) table<-table[1:(nrow(table)-droplast),] - sqlSave(conn, table, tablename = tablename, safer = F) + + if (dbtype == "OV"){sqlSave(conn, table, tablename = tablename, safer = F)} + if (dbtype == "UM"){ + sqlDrop(conn, tablename) + sqlSave(conn, table, tablename = tablename, safer = F)} } ``` @@ -93,13 +101,14 @@ sqlInitialize<-function(){ Creates a Back Up copy of the database. ### Usage -sqlBackUp(dbfile=file,bu.dir="BU_OVARIO") +sqlBackUp(dbfile=file,conn=dta,bu.dir=NULL) ### Arguments Argument|Description ---|--- dbfile| Database File location. -bu.dir| Directory under the DB file where the back up will be placed. +conn|connection handle returned by odbcConnect. +bu.dir|Directory under the DB file where the back up will be placed. It defaults to NULL and is deduced from conn database. ### Details Creates a Back Up copy of the database. It adds the date in front of the back up file. @@ -115,7 +124,10 @@ sqlBackUp() ### Function ```r -sqlBackUp<-function(dbfile=file,bu.dir="BU_OVARIO"){ +sqlBackUp<-function(dbfile=file,conn=dta,bu.dir=NULL){ + if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){bu.dir<-"BU_UM"} + if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"BU_OVARIO"} + db=strsplit(dbfile, "/")[[1]]%>% tail(n=1) bu_path<-gsub(db,bu.dir,dbfile) if (!dir.exists(bu_path)){ @@ -135,7 +147,7 @@ sqlBackUp<-function(dbfile=file,bu.dir="BU_OVARIO"){ Shows if there are already samples from the specified NHCs. ### Usage -sqlShowSamples(conn=dta, nhcs=nhc.test, verb=F) +sqlShowSamples(conn=dta, nhcs=nhc.test, verb=F, dbtype=NULL) ### Arguments Argument|Description @@ -143,6 +155,7 @@ Argument|Description conn|connection handle returned by odbcConnect. nhcs|Character vector with the NHCs to test. verb|Verbose: if TRUE, all the columns from "SAMPLES" table are printed. +dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced. ### Details Takes the NHCs listed in the nhcs vector and checks if there are already samples from those patients. @@ -159,18 +172,27 @@ sqlShowSamples() ### Function ```r -sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F){ +sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F, dbtype=NULL){ + if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} + if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} + + if (dbtype == "OV"){ + db<-c("dbtables"="SAMPLES", "dbcode"="OVID", "dbsamples"="samples") + query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"]) + } + if (dbtype == "UM"){ + db<-c("dbtables"="MUESTRAS", "dbcode"="UMID", "dbsamples"="CODIGO") + query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"]) + } + if (nrow(sqlQuery(conn, query) %>% filter(NHC %in% nhcs)) == 0){ + return("No hay muestras de ningún paciente.") + } if (isFALSE(verb)){ - sqlQuery(conn, "SELECT O.NHC,S.* - FROM SAMPLES S - INNER JOIN OVID O - ON O.OVID=S.OVID") %>% filter(NHC %in% nhcs) %>% - group_by(NHC,OVID) %>% summarise(Samples=length(samples), Names=paste0(samples, collapse = ";")) %>% merge(data.frame(NHC=nhcs),all=T) + sqlQuery(conn, query) %>% filter(NHC %in% nhcs) %>% + group_by(NHC,UQ(rlang::sym(db["dbcode"]))) %>% summarise(Samples=length(UQ(rlang::sym(db["dbsamples"]))), Names=paste0(UQ(rlang::sym(db["dbsamples"])), collapse = ";")) %>% + merge(data.frame(NHC=nhcs),all=T) %>% mutate(NHC=factor(NHC,levels = nhcs)) %>% arrange(NHC) }else{ - sqlQuery(conn, "SELECT O.NHC,S.* - FROM SAMPLES S - INNER JOIN OVID O - ON O.OVID=S.OVID") %>% filter(NHC %in% nhcs) + sqlQuery(conn, query) %>% filter(NHC %in% nhcs) } } ``` @@ -180,10 +202,10 @@ sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F){ ## sqlGenOVID ### Description -Generates new consecutive OVID code for the patients that are not found in the DB. +Generates new consecutive OVID or UMID code for the patients that are not found in the DB. ### Usage -sqlGenOVID(conn=dta, nhcs=nhc.test, verb=T, sinc=F) +sqlGenOVID(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL) ### Arguments Argument|Description @@ -192,9 +214,10 @@ conn|connection handle returned by odbcConnect. nhcs|Character vector with the NHCs to test. verb|Verbose: if TRUE (default), it prints the data.frame with the generated OVID codes. sinc|If TRUE (default is FALSE for security), it adds the new entries to the "OVID" table in the DB. +dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced. ### Details -Generates new consecutive OVID code for the patients that are not found in the DB. +Generates new consecutive OVID or UMID code for the patients that are not found in the DB. ### Value If verb is TRUE, it returns a data.frame. @@ -208,23 +231,41 @@ sqlGenOVID(sinc=T) ### Function ```r -sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F){ - ovid<-sqlFetch(conn,"OVID") +sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL){ + if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} + if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} - new.nhc<-nhcs[!nhcs %in% ovid$NHC] - next.num<-gsub("OVID","",ovid$OVID) %>% as.numeric %>% max(na.rm=T)+1 + if (dbtype == "OV"){ + db<-c("dbcode"="OVID") + } + if (dbtype == "UM"){ + db<-c("dbcode"="UMID") + } + + dbid<-sqlFetch(conn,db["dbcode"]) + + new.nhc<-nhcs[!nhcs %in% dbid$NHC] + next.num<-gsub(db["dbcode"],"",dbid[,db["dbcode"]]) %>% as.numeric %>% max(na.rm=T)+1 last.num<-next.num+(length(new.nhc)-1) - upd.ovid<-rbind(ovid,data.frame("NHC"=new.nhc, "OVID"=sprintf("OVID%04d",next.num:last.num))) - rownames(upd.ovid)<-as.character(1:nrow(upd.ovid)) - upd.ovid<-filter(upd.ovid, NHC %in% new.nhc) %>% mutate(NHC=as.character(NHC)) + newtab<-data.frame("NHC"=new.nhc, "ID"=sprintf("%s%04d",db["dbcode"],next.num:last.num)) %>% rename(!!db["dbcode"]:="ID") + if(dbtype=="OV"){ + dbid<-rbind(dbid,newtab) + } + if(dbtype=="UM"){ + dbid<-merge(dbid, newtab, all=T) %>% select(Id,NHC,UMID) %>% arrange(Id) + dbid$Id<-as.numeric(rownames(dbid)) + dbid$NHC<-as.numeric(dbid$NHC) + } + rownames(dbid)<-as.character(1:nrow(dbid)) + dbid<-filter(dbid, NHC %in% new.nhc) %>% mutate(NHC=as.character(NHC)) if (sinc){ ### !! Atención, esto cambia la base de datos: - sqlSave(conn, upd.ovid, tablename="OVID", append = T) + sqlSave(conn, dbid, tablename=db["dbcode"], append = T) print("La base ha sido actualizada.") } if (verb){ - return(upd.ovid) + return(dbid) } } ``` @@ -234,10 +275,10 @@ sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F){ ## sqlWriteTemp ### Description -Fills the Query Template file with the OVID and OV newly generated codes. +Fills the Query Template file with the OVID or UMID and OV or UM newly generated codes. ### Usage -sqlWriteTemp(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T) +sqlWriteTemp(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T, dbtype=NULL) ### Arguments Argument|Description @@ -247,9 +288,10 @@ nhcs|Character vector with the NHCs to test. file|Template file that will be used to interact with the DB. samples.mod|If TRUE (default), it fills the "samples" template sheet. clinics.mod|If TRUE (default), it fills the "CLINICS" template sheet. +dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced. ### Details -Fills the Query Template file with the OVID and OV newly generated codes. It is required that the DB has been updated with the sqlGenOVID function. It replaces previous content in the template file sheets that are filled. In the case of "CLINICS" table, if there were already an entry in the DB for that OVID code, the template file is filled with that information. +Fills the Query Template file with the OVID and OV or UMID and UM newly generated codes. It is required that the DB has been updated with the sqlGenOVID function. It replaces previous content in the template file sheets that are filled. In the case of "CLINICS" table, if there were already an entry in the DB for that OVID/UMID code, the template file is filled with that information. ### Value Invisibly for success (and failures cause errors). @@ -264,37 +306,74 @@ sqlWriteTemp() ### Function ```r -sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T){ - upd.ovid<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs) - if (samples.mod){ - ## Generar código para las nuevas muestras - samples<-sqlFetch(conn, "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 +sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T, dbtype=NULL){ + if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} + if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} + + if (dbtype=="OV"){ + upd.ovid<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs) + if (samples.mod){ + ## Generar código para las nuevas muestras + samples<-sqlFetch(conn, "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 + } + last.samp<-next.samp+(length(nhcs)-1) + new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp) + new.samp.df<-merge(sqlFetch(dta,"OVID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "samples"=new.samp)) + samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples) + } + + if (clinics.mod){ + ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos + upd.clinics<-sqlFetch(conn, "CLINICS") + ovid.new<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs) + upd.clinics<-merge(ovid.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])} } - last.samp<-next.samp+(length(nhcs)-1) - new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp) - new.samp.df<-merge(sqlFetch(dta,"OVID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "samples"=new.samp)) - samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples) - } - if (clinics.mod){ - ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos - upd.clinics<-sqlFetch(conn, "CLINICS") - ovid.new<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs) - upd.clinics<-merge(ovid.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])} + ## Exportar tablas a la plantilla de entrada para su rellenado + wb <- loadWorkbook(file) + writeData(wb, "NHC", upd.ovid) + if (samples.mod){writeData(wb,"samples",samples.exp)} + if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)} + saveWorkbook(wb,file,overwrite = TRUE) + } + if (dbtype=="UM"){ + upd.umid<-sqlFetch(conn, "UMID") %>% filter(NHC %in% nhcs) + if (samples.mod){ + ## Generar código para las nuevas muestras + samples<-sqlFetch(conn, "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(nhcs)-1) + new.samp<-sprintf("UM%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp) + new.samp.df<-merge(sqlFetch(dta,"UMID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "CODIGO"=new.samp)) + samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO) + } + + if (clinics.mod){ + ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos + upd.clinics<-sqlFetch(conn, "CLINICOS") + umid.new<-sqlFetch(conn, "UMID") %>% filter(NHC %in% nhcs) + upd.clinics<-merge(umid.new,upd.clinics %>% select(-Id), 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])} + } + + ## Exportar tablas a la plantilla de entrada para su rellenado + wb <- loadWorkbook(file) + writeData(wb, "NHC", upd.umid) + if (samples.mod){writeData(wb,"samples",samples.exp)} + if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)} + saveWorkbook(wb,file,overwrite = TRUE) } - - ## Exportar tablas a la plantilla de entrada para su rellenado - wb <- loadWorkbook(file) - writeData(wb, "NHC", upd.ovid) - if (samples.mod){writeData(wb,"samples",samples.exp)} - if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)} - saveWorkbook(wb,file,overwrite = TRUE) } ``` @@ -306,7 +385,7 @@ sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod Updates the DB with the information filled in the template file. ### Usage -sqlSincBD(conn=dta, filetemp="QueryOV.xlsx", sinc.samples=F, sinc.clinics=F) +sqlSincBD(conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clinics=F, dbtype=NULL) ### Arguments Argument|Description @@ -315,6 +394,7 @@ conn|connection handle returned by odbcConnect. filetemp|Template file that will be used to interact with the DB. sinc.samples|If TRUE (default is FALSE for security), it updates the SAMPLES table in the DB with the information in the "samples" template sheet. clinics.mod|If TRUE (default is FALSE for security), it updates the CLINICS table in the DB with the information in the "CLINICS" template sheet. +dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced. ### Details Updates the DB with the information filled in the template file. All the "samples" entries are added as new rows (as all samples are new even if the patient was already in the DB). The new patients included in the "CLINICS" sheet are introduced in the DB as new rows and the ones that were already there are modified in its previous row location. @@ -333,52 +413,168 @@ sqlSincBD(sinc.samples=T, sinc.clinics=T) ### Function ```r -sqlSincBD<-function(conn=dta, filetemp="QueryOV.xlsx", sinc.samples=F, sinc.clinics=F){ - ## Añadir código de muestra nueva a la base de datos - nsamples<-sqlFetch(conn, "SAMPLES") %>% nrow - upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T) - if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character} +sqlSincBD<-function(conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clinics=F, dbtype=NULL){ + if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} + if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} - if (sinc.samples & nrow(upd.samples) > 0){ - upd.samples$IQ_date<-as.Date(upd.samples$IQ_date) - ### !! Atención, esto cambia la base de datos: - sqlSave(conn, upd.samples, tablename="SAMPLES", append = T, varTypes = c("IQ_date"="date")) - print("Tabla SAMPLES sincronizada.") + ## Añadir código de muestra nueva a la base de datos + if (dbtype == "OV"){ + print("DB OV detectada") + nsamples<-sqlFetch(conn, "SAMPLES") %>% nrow + upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T) + if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character} + + if (sinc.samples & nrow(upd.samples) > 0){ + upd.samples$IQ_date<-as.Date(upd.samples$IQ_date) + upd.samples$TIL_date<-as.Date(upd.samples$TIL_date) + ### !! Atención, esto cambia la base de datos: + sqlSave(conn, upd.samples, tablename="SAMPLES", append = T, varTypes = c("IQ_date"="date","TIL_date"="date")) + print("Tabla SAMPLES sincronizada.") + } + } + if (dbtype == "UM"){ + print("DB UM detectada") + nsamples<-sqlFetch(conn, "MUESTRAS") %>% nrow + upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T) + if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character} + + if (sinc.samples & nrow(upd.samples) > 0){ + upd.samples$FECHA_RECEPCION<-as.Date(upd.samples$FECHA_RECEPCION) + 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(conn, upd.samples, tablename="MUESTRAS", append = T, varTypes = c("FECHA_RECEPCION"="Date"), rownames = F) + print("Tabla MUESTRAS sincronizada.") + } } ## Añadir datos clínicos modificados a la base de datos - upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T) - ovid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))] - rnames<-sqlFetch(conn, "CLINICS") %>% filter(OVID %in% ovid.mod) %>% rownames - clinics.mod<-upd.clinics %>% filter(OVID %in% ovid.mod) %>% select(-NHC) - rownames(clinics.mod)<-rnames - - ### !! Atención, esto cambia la base de datos: - if (sinc.clinics){ - fechas<-colnames(clinics.mod)[grepl("DO|date", colnames(clinics.mod))] - for (i in fechas){ - clinics.mod[,i]<-as.Date(clinics.mod[,i]) + if (dbtype == "OV"){ + upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T) + ovid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))] + rnames<-sqlFetch(conn, "CLINICS") %>% filter(OVID %in% ovid.mod) %>% rownames + clinics.mod<-upd.clinics %>% filter(OVID %in% ovid.mod) %>% select(-NHC) + rownames(clinics.mod)<-rnames + + ### !! Atención, esto cambia la base de datos: + if (sinc.clinics){ + fechas<-colnames(clinics.mod)[grepl("DO|date", colnames(clinics.mod))] + for (i in fechas){ + clinics.mod[,i]<-as.Date(clinics.mod[,i]) + } + sqlUpdate(conn, clinics.mod,"CLINICS") + print("Tabla CLINICS modificada.") + } + } + if (dbtype == "UM"){ + upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T) + umid.mod<-upd.clinics$UMID[upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))] + rnames<-sqlFetch(conn, "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: + if (sinc.clinics){ + fechas<-colnames(clinics.mod)[grepl("date|MET_DX|DoB", colnames(clinics.mod), ignore.case = T)] + for (i in fechas){ + clinics.mod[,i]<-as.Date(clinics.mod[,i]) + } + sqlUpdate(conn, clinics.mod,"CLINICOS") + print("Tabla CLINICOS modificada.") } - sqlUpdate(conn, clinics.mod,"CLINICS") - print("Tabla CLINICS modificada.") } ## Añadir datos clínicos nuevos a la base de datos - nsamples.clin<-sqlFetch(conn, "CLINICS") %>% nrow - ovid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(conn, "CLINICS") %>% pull(OVID))] - clinics.new<-upd.clinics %>% filter(OVID %in% ovid.new) %>% select(-NHC) - if (length(ovid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character} - - ### !! Atención, esto cambia la base de datos: - if (sinc.clinics){ - fechas<-colnames(clinics.new)[grepl("DO|date", colnames(clinics.new))] - varTypes<-rep("Date",length(fechas)) - names(varTypes)<-fechas - for (i in fechas){ - clinics.new[,i]<-as.Date(clinics.new[,i]) + if (dbtype == "OV"){ + nsamples.clin<-sqlFetch(conn, "CLINICS") %>% nrow + ovid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(conn, "CLINICS") %>% pull(OVID))] + clinics.new<-upd.clinics %>% filter(OVID %in% ovid.new) %>% select(-NHC) + if (length(ovid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character} + + ### !! Atención, esto cambia la base de datos: + if (sinc.clinics){ + fechas<-colnames(clinics.new)[grepl("DO|date", colnames(clinics.new))] + varTypes<-rep("Date",length(fechas)) + names(varTypes)<-fechas + for (i in fechas){ + clinics.new[,i]<-as.Date(clinics.new[,i]) + } + sqlSave(conn, clinics.new, tablename="CLINICS", append = T, varTypes = varTypes) + print("Tabla CLINICS sincronizada.") + } + } + if (dbtype == "UM"){ + nsamples.clin<-sqlFetch(conn, "CLINICOS") %>% nrow + umid.new<-upd.clinics$UMID[!upd.clinics$UMID %in% (sqlFetch(conn, "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: + if (sinc.clinics){ + 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]<-as.Date(clinics.new[,i]) + } + sqlSave(conn, clinics.new, tablename="CLINICOS", append = T, varTypes = varTypes) + print("Tabla CLINICOS sincronizada.") } - sqlSave(conn, clinics.new, tablename="CLINICS", append = T, varTypes = varTypes) - print("Tabla CLINICS sincronizada.") } } -``` \ No newline at end of file +``` + +--- + +## sqlMultiSamples + +### Description +Prints a table compiling information about laboratory samples, scRNAseq samples and RNA/DNA samples. + +### Usage +sqlMultiSamples(kbl=F, NHC=F, full=F) + +### Arguments +Argument|Description +---|--- +kbl|formats the output table with the kableEstra style. Defaults to F. +NHC|adds the NHC to the table in addition to the UMID. Defaults to F. +full|prints also the patients that doesn't appear in the MUESTRAS table. Defaults to F. + +### Details +Prints a table compiling information about laboratory samples, scRNAseq samples and RNA/DNA samples. + +### Value +A data.frame or a kableExtra table. + +### Examples +```r +dta<-odbcConnect("test") +sqlMultiSamples() +``` + +### Function +```r +sqlMultiSamples<-function(kbl=F, NHC=F, full=F){ + query<-sqlQuery(dta, "SELECT U.UMID,U.NHC,M.FECHA_RECEPCION,M.TIPO,M.CODIGO,C.CODIGO,R.CODIGO,R.ESTADO + FROM ((UMID U + LEFT OUTER JOIN MUESTRAS M ON U.UMID=M.UMID) + LEFT OUTER JOIN CNAG C ON M.CODIGO=C.CODIGO) + LEFT OUTER JOIN RNADNA R ON M.CODIGO=R.CODIGO") %>% rename("CNAG"="CODIGO.1","RNADNA"="CODIGO.2") + + if (full==F){query<- query %>% filter(!is.na(CODIGO))} + if (NHC==F){query<- query %>% select(-NHC)} + + query<-query %>% mutate( + CNAG=case_when(!is.na(CNAG)~"X",TRUE~""), + RNADNA=case_when((!is.na(RNADNA) & (ESTADO=="ENV"))~"X", + (!is.na(RNADNA) & (is.na(ESTADO)))~".", + TRUE~"") + ) %>% select(-ESTADO) + if (kbl==T){ + query %>% kableExtra::kbl() %>% kableExtra::kable_styling(full_width = F, bootstrap_options = c("striped")) + }else{ + return(query) + } +} +``` diff --git a/Docs/sqlFunctions-doc.html b/Docs/sqlFunctions-doc.html index e3eb3f8..e7d4a33 100644 --- a/Docs/sqlFunctions-doc.html +++ b/Docs/sqlFunctions-doc.html @@ -176,6 +176,7 @@ pre code {
  • sqlGenOVID
  • sqlWriteTemp
  • sqlSincBD
  • +
  • sqlMultiSamples
  • @@ -188,7 +189,7 @@ pre code {

    Usage

    -

    sqlDropLast(conn, tablename, droplast=1)

    +

    sqlDropLast(conn, tablename, droplast=1, dbtype=NULL)

    Arguments

    @@ -216,6 +217,10 @@ pre code { droplast the amount of lines to be removed from the table strating from tail. By default, it removes only 1 line. + +dbtype +used to manually specify the database type. It defaults to NULL and the type is deduced. +
    @@ -234,10 +239,17 @@ sqlDropLast(dta, "TableTest")

    Function

    -
    sqlDropLast<-function(conn, tablename, droplast=1){
    +
    sqlDropLast<-function(conn, tablename, droplast=1,dbtype=NULL){
    +  if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
    +  if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
    +  
       table<-sqlFetch(conn, tablename)
       table<-table[1:(nrow(table)-droplast),]
    -  sqlSave(conn, table, tablename = tablename, safer = F)
    +  
    +  if (dbtype == "OV"){sqlSave(conn, table, tablename = tablename, safer = F)}
    +  if (dbtype == "UM"){
    +    sqlDrop(conn, tablename)
    +    sqlSave(conn, table, tablename = tablename, safer = F)}
     }

    @@ -298,11 +310,15 @@ sqlDropLast(dta, "TableTest")

    Usage

    -

    sqlBackUp(dbfile=file,bu.dir=“BU_OVARIO”)

    +

    sqlBackUp(dbfile=file,conn=dta,bu.dir=NULL)

    Arguments

    ++++ @@ -315,8 +331,12 @@ sqlDropLast(dta, "TableTest") + + + + - +
    Argument Database File location.
    connconnection handle returned by odbcConnect.
    bu.dirDirectory under the DB file where the back up will be placed.Directory under the DB file where the back up will be placed. It defaults to NULL and is deduced from conn database.
    @@ -336,7 +356,10 @@ sqlBackUp()

    Function

    -
    sqlBackUp<-function(dbfile=file,bu.dir="BU_OVARIO"){
    +
    sqlBackUp<-function(dbfile=file,conn=dta,bu.dir=NULL){
    +  if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){bu.dir<-"BU_UM"}
    +  if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"BU_OVARIO"}
    +  
       db=strsplit(dbfile, "/")[[1]]%>% tail(n=1)
       bu_path<-gsub(db,bu.dir,dbfile)
       if (!dir.exists(bu_path)){
    @@ -357,11 +380,15 @@ sqlBackUp()

    Usage

    -

    sqlShowSamples(conn=dta, nhcs=nhc.test, verb=F)

    +

    sqlShowSamples(conn=dta, nhcs=nhc.test, verb=F, dbtype=NULL)

    Arguments

    ++++ @@ -381,6 +408,10 @@ sqlBackUp() + + + +
    Argument verb Verbose: if TRUE, all the columns from “SAMPLES” table are printed.
    dbtypeused to manually specify the database type. It defaults to NULL and the type is deduced.
    @@ -400,18 +431,27 @@ sqlShowSamples()

    Function

    -
    sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F){
    +
    sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F, dbtype=NULL){
    +  if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
    +  if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
    +  
    +  if (dbtype == "OV"){
    +    db<-c("dbtables"="SAMPLES", "dbcode"="OVID", "dbsamples"="samples")
    +    query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"])
    +  }
    +  if (dbtype == "UM"){
    +    db<-c("dbtables"="MUESTRAS", "dbcode"="UMID", "dbsamples"="CODIGO")
    +    query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"])
    +  }
    +  if (nrow(sqlQuery(conn, query) %>% filter(NHC %in% nhcs)) == 0){
    +    return("No hay muestras de ningún paciente.")
    +  }
       if (isFALSE(verb)){
    -    sqlQuery(conn, "SELECT O.NHC,S.* 
    -         FROM SAMPLES S 
    -         INNER JOIN OVID O 
    -         ON O.OVID=S.OVID") %>% filter(NHC %in% nhcs) %>% 
    -    group_by(NHC,OVID) %>% summarise(Samples=length(samples), Names=paste0(samples, collapse = ";")) %>% merge(data.frame(NHC=nhcs),all=T)
    +    sqlQuery(conn, query) %>% filter(NHC %in% nhcs) %>% 
    +    group_by(NHC,UQ(rlang::sym(db["dbcode"]))) %>% summarise(Samples=length(UQ(rlang::sym(db["dbsamples"]))), Names=paste0(UQ(rlang::sym(db["dbsamples"])), collapse = ";")) %>% 
    +      merge(data.frame(NHC=nhcs),all=T) %>% mutate(NHC=factor(NHC,levels = nhcs)) %>% arrange(NHC)
       }else{
    -    sqlQuery(conn, "SELECT O.NHC,S.* 
    -         FROM SAMPLES S 
    -         INNER JOIN OVID O 
    -         ON O.OVID=S.OVID") %>% filter(NHC %in% nhcs)
    +    sqlQuery(conn, query) %>% filter(NHC %in% nhcs)
       }
     }

    @@ -421,11 +461,11 @@ sqlShowSamples()

    sqlGenOVID

    Description

    -

    Generates new consecutive OVID code for the patients that are not found in the DB.

    +

    Generates new consecutive OVID or UMID code for the patients that are not found in the DB.

    Usage

    -

    sqlGenOVID(conn=dta, nhcs=nhc.test, verb=T, sinc=F)

    +

    sqlGenOVID(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL)

    Arguments

    @@ -457,12 +497,16 @@ sqlShowSamples() sinc If TRUE (default is FALSE for security), it adds the new entries to the “OVID” table in the DB. + +dbtype +used to manually specify the database type. It defaults to NULL and the type is deduced. +

    Details

    -

    Generates new consecutive OVID code for the patients that are not found in the DB.

    +

    Generates new consecutive OVID or UMID code for the patients that are not found in the DB.

    Value

    @@ -476,23 +520,41 @@ sqlGenOVID(sinc=T)

    Function

    -
    sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F){
    -  ovid<-sqlFetch(conn,"OVID")
    +
    sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL){
    +  if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
    +  if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
    +  
    +  if (dbtype == "OV"){
    +    db<-c("dbcode"="OVID")
    +  }
    +  if (dbtype == "UM"){
    +    db<-c("dbcode"="UMID")
    +  }
       
    -  new.nhc<-nhcs[!nhcs %in% ovid$NHC]
    -  next.num<-gsub("OVID","",ovid$OVID) %>% as.numeric %>% max(na.rm=T)+1
    +  dbid<-sqlFetch(conn,db["dbcode"])
    +  
    +  new.nhc<-nhcs[!nhcs %in% dbid$NHC]
    +  next.num<-gsub(db["dbcode"],"",dbid[,db["dbcode"]]) %>% as.numeric %>% max(na.rm=T)+1
       last.num<-next.num+(length(new.nhc)-1)
    -  upd.ovid<-rbind(ovid,data.frame("NHC"=new.nhc, "OVID"=sprintf("OVID%04d",next.num:last.num)))
    -  rownames(upd.ovid)<-as.character(1:nrow(upd.ovid))
    -  upd.ovid<-filter(upd.ovid, NHC %in% new.nhc) %>% mutate(NHC=as.character(NHC))
    +  newtab<-data.frame("NHC"=new.nhc, "ID"=sprintf("%s%04d",db["dbcode"],next.num:last.num)) %>% rename(!!db["dbcode"]:="ID")
    +  if(dbtype=="OV"){
    +    dbid<-rbind(dbid,newtab)
    +  }
    +  if(dbtype=="UM"){
    +    dbid<-merge(dbid, newtab, all=T) %>% select(Id,NHC,UMID) %>% arrange(Id)
    +    dbid$Id<-as.numeric(rownames(dbid))
    +    dbid$NHC<-as.numeric(dbid$NHC)
    +  }
    +  rownames(dbid)<-as.character(1:nrow(dbid))
    +  dbid<-filter(dbid, NHC %in% new.nhc) %>% mutate(NHC=as.character(NHC))
       
       if (sinc){
         ### !! Atención, esto cambia la base de datos:
    -    sqlSave(conn, upd.ovid, tablename="OVID", append = T)
    +    sqlSave(conn, dbid, tablename=db["dbcode"], append = T)
         print("La base ha sido actualizada.")
       }
       if (verb){
    -    return(upd.ovid)
    +    return(dbid)
       }
     }

    @@ -502,15 +564,19 @@ sqlGenOVID(sinc=T)

    sqlWriteTemp

    Description

    -

    Fills the Query Template file with the OVID and OV newly generated codes.

    +

    Fills the Query Template file with the OVID or UMID and OV or UM newly generated codes.

    Usage

    -

    sqlWriteTemp(conn=dta, nhcs=nhc.test, file=“queryOV.xlsx”, samples.mod=T, clinics.mod=T)

    +

    sqlWriteTemp(conn=dta, nhcs=nhc.test, file=“queryOV.xlsx”, samples.mod=T, clinics.mod=T, dbtype=NULL)

    Arguments

    ++++ @@ -538,12 +604,16 @@ sqlGenOVID(sinc=T) + + + +
    Argument clinics.mod If TRUE (default), it fills the “CLINICS” template sheet.
    dbtypeused to manually specify the database type. It defaults to NULL and the type is deduced.

    Details

    -

    Fills the Query Template file with the OVID and OV newly generated codes. It is required that the DB has been updated with the sqlGenOVID function. It replaces previous content in the template file sheets that are filled. In the case of “CLINICS” table, if there were already an entry in the DB for that OVID code, the template file is filled with that information.

    +

    Fills the Query Template file with the OVID and OV or UMID and UM newly generated codes. It is required that the DB has been updated with the sqlGenOVID function. It replaces previous content in the template file sheets that are filled. In the case of “CLINICS” table, if there were already an entry in the DB for that OVID/UMID code, the template file is filled with that information.

    Value

    @@ -558,37 +628,74 @@ sqlWriteTemp()

    Function

    -
    sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T){
    -  upd.ovid<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs)
    -  if (samples.mod){
    -    ## Generar código para las nuevas muestras
    -    samples<-sqlFetch(conn, "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
    +
    sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T, dbtype=NULL){
    +  if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
    +  if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
    +  
    +  if (dbtype=="OV"){
    +    upd.ovid<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs)
    +    if (samples.mod){
    +      ## Generar código para las nuevas muestras
    +      samples<-sqlFetch(conn, "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
    +      }
    +      last.samp<-next.samp+(length(nhcs)-1)
    +      new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp)
    +      new.samp.df<-merge(sqlFetch(dta,"OVID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "samples"=new.samp))
    +      samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples)
    +    }
    +    
    +    if (clinics.mod){
    +      ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
    +      upd.clinics<-sqlFetch(conn, "CLINICS")
    +      ovid.new<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs)
    +      upd.clinics<-merge(ovid.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])}
         }
    -    last.samp<-next.samp+(length(nhcs)-1)
    -    new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp)
    -    new.samp.df<-merge(sqlFetch(dta,"OVID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "samples"=new.samp))
    -    samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples)
    -  }
       
    -  if (clinics.mod){
    -    ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
    -    upd.clinics<-sqlFetch(conn, "CLINICS")
    -    ovid.new<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs)
    -    upd.clinics<-merge(ovid.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])}
    +    ## Exportar tablas a la plantilla de entrada para su rellenado
    +    wb <- loadWorkbook(file)
    +    writeData(wb, "NHC", upd.ovid)
    +    if (samples.mod){writeData(wb,"samples",samples.exp)}
    +    if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)}
    +    saveWorkbook(wb,file,overwrite = TRUE)
    +  }
    +  if (dbtype=="UM"){
    +    upd.umid<-sqlFetch(conn, "UMID") %>% filter(NHC %in% nhcs)
    +    if (samples.mod){
    +      ## Generar código para las nuevas muestras
    +      samples<-sqlFetch(conn, "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(nhcs)-1)
    +      new.samp<-sprintf("UM%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp)
    +      new.samp.df<-merge(sqlFetch(dta,"UMID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "CODIGO"=new.samp))
    +      samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO)
    +    }
    +    
    +    if (clinics.mod){
    +      ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
    +      upd.clinics<-sqlFetch(conn, "CLINICOS")
    +      umid.new<-sqlFetch(conn, "UMID") %>% filter(NHC %in% nhcs)
    +      upd.clinics<-merge(umid.new,upd.clinics %>% select(-Id), 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])}
    +    }
    +    
    +    ## Exportar tablas a la plantilla de entrada para su rellenado
    +    wb <- loadWorkbook(file)
    +    writeData(wb, "NHC", upd.umid)
    +    if (samples.mod){writeData(wb,"samples",samples.exp)}
    +    if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)}
    +    saveWorkbook(wb,file,overwrite = TRUE)
       }
    -
    -  ## Exportar tablas a la plantilla de entrada para su rellenado
    -  wb <- loadWorkbook(file)
    -  writeData(wb, "NHC", upd.ovid)
    -  if (samples.mod){writeData(wb,"samples",samples.exp)}
    -  if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)}
    -  saveWorkbook(wb,file,overwrite = TRUE)
     }

    @@ -601,7 +708,7 @@ sqlWriteTemp()

    Usage

    -

    sqlSincBD(conn=dta, filetemp=“QueryOV.xlsx”, sinc.samples=F, sinc.clinics=F)

    +

    sqlSincBD(conn=dta, filetemp=“queryOV.xlsx”, sinc.samples=F, sinc.clinics=F, dbtype=NULL)

    Arguments

    @@ -633,6 +740,10 @@ sqlWriteTemp() clinics.mod If TRUE (default is FALSE for security), it updates the CLINICS table in the DB with the information in the “CLINICS” template sheet. + +dbtype +used to manually specify the database type. It defaults to NULL and the type is deduced. +
    @@ -654,53 +765,193 @@ sqlSincBD(sinc.samples=T, sinc.clinics=T)

    Function

    -
    sqlSincBD<-function(conn=dta, filetemp="QueryOV.xlsx", sinc.samples=F, sinc.clinics=F){
    -  ## Añadir código de muestra nueva a la base de datos
    -  nsamples<-sqlFetch(conn, "SAMPLES") %>% nrow
    -  upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T)
    -  if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character}
    +
    sqlSincBD<-function(conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clinics=F, dbtype=NULL){
    +  if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
    +  if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
       
    -  if (sinc.samples & nrow(upd.samples) > 0){
    -    upd.samples$IQ_date<-as.Date(upd.samples$IQ_date)
    -    ### !! Atención, esto cambia la base de datos:
    -    sqlSave(conn, upd.samples, tablename="SAMPLES", append = T, varTypes = c("IQ_date"="date"))
    -    print("Tabla SAMPLES sincronizada.")
    +  ## Añadir código de muestra nueva a la base de datos
    +  if (dbtype == "OV"){
    +    print("DB OV detectada")
    +    nsamples<-sqlFetch(conn, "SAMPLES") %>% nrow
    +    upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T)
    +    if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character}
    +    
    +    if (sinc.samples & nrow(upd.samples) > 0){
    +      upd.samples$IQ_date<-as.Date(upd.samples$IQ_date)
    +      upd.samples$TIL_date<-as.Date(upd.samples$TIL_date)
    +      ### !! Atención, esto cambia la base de datos:
    +      sqlSave(conn, upd.samples, tablename="SAMPLES", append = T, varTypes = c("IQ_date"="date","TIL_date"="date"))
    +      print("Tabla SAMPLES sincronizada.")
    +    }
    +  }
    +  if (dbtype == "UM"){
    +    print("DB UM detectada")
    +    nsamples<-sqlFetch(conn, "MUESTRAS") %>% nrow
    +    upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T)
    +    if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character}
    +    
    +    if (sinc.samples & nrow(upd.samples) > 0){
    +      upd.samples$FECHA_RECEPCION<-as.Date(upd.samples$FECHA_RECEPCION)
    +      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(conn, upd.samples, tablename="MUESTRAS", append = T, varTypes = c("FECHA_RECEPCION"="Date"), rownames = F)
    +      print("Tabla MUESTRAS sincronizada.")
    +    }
       }
       
       ## Añadir datos clínicos modificados a la base de datos
    -  upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T)
    -  ovid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))]
    -  rnames<-sqlFetch(conn, "CLINICS") %>% filter(OVID %in% ovid.mod) %>% rownames
    -  clinics.mod<-upd.clinics %>% filter(OVID %in% ovid.mod) %>% select(-NHC)
    -  rownames(clinics.mod)<-rnames
    -  
    -  ### !! Atención, esto cambia la base de datos:
    -  if (sinc.clinics){
    -    fechas<-colnames(clinics.mod)[grepl("DO|date", colnames(clinics.mod))]
    -    for (i in fechas){
    -      clinics.mod[,i]<-as.Date(clinics.mod[,i])
    +  if (dbtype == "OV"){
    +    upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T)
    +    ovid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))]
    +    rnames<-sqlFetch(conn, "CLINICS") %>% filter(OVID %in% ovid.mod) %>% rownames
    +    clinics.mod<-upd.clinics %>% filter(OVID %in% ovid.mod) %>% select(-NHC)
    +    rownames(clinics.mod)<-rnames
    +    
    +    ### !! Atención, esto cambia la base de datos:
    +    if (sinc.clinics){
    +      fechas<-colnames(clinics.mod)[grepl("DO|date", colnames(clinics.mod))]
    +      for (i in fechas){
    +        clinics.mod[,i]<-as.Date(clinics.mod[,i])
    +      }
    +      sqlUpdate(conn, clinics.mod,"CLINICS")
    +      print("Tabla CLINICS modificada.")
    +    }
    +  }
    +  if (dbtype == "UM"){
    +    upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T)
    +    umid.mod<-upd.clinics$UMID[upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))]
    +    rnames<-sqlFetch(conn, "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:
    +    if (sinc.clinics){
    +      fechas<-colnames(clinics.mod)[grepl("date|MET_DX|DoB", colnames(clinics.mod), ignore.case = T)]
    +      for (i in fechas){
    +        clinics.mod[,i]<-as.Date(clinics.mod[,i])
    +      }
    +      sqlUpdate(conn, clinics.mod,"CLINICOS")
    +      print("Tabla CLINICOS modificada.")
         }
    -    sqlUpdate(conn, clinics.mod,"CLINICS")
    -    print("Tabla CLINICS modificada.")
       }
       
       ## Añadir datos clínicos nuevos a la base de datos
    -  nsamples.clin<-sqlFetch(conn, "CLINICS") %>% nrow
    -  ovid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(conn, "CLINICS") %>% pull(OVID))]
    -  clinics.new<-upd.clinics %>% filter(OVID %in% ovid.new) %>% select(-NHC)
    -  if (length(ovid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character}
    -  
    -  ### !! Atención, esto cambia la base de datos:
    -  if (sinc.clinics){
    -    fechas<-colnames(clinics.new)[grepl("DO|date", colnames(clinics.new))]
    -    varTypes<-rep("Date",length(fechas))
    -    names(varTypes)<-fechas
    -    for (i in fechas){
    -      clinics.new[,i]<-as.Date(clinics.new[,i])
    +  if (dbtype == "OV"){
    +    nsamples.clin<-sqlFetch(conn, "CLINICS") %>% nrow
    +    ovid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(conn, "CLINICS") %>% pull(OVID))]
    +    clinics.new<-upd.clinics %>% filter(OVID %in% ovid.new) %>% select(-NHC)
    +    if (length(ovid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character}
    +    
    +    ### !! Atención, esto cambia la base de datos:
    +    if (sinc.clinics){
    +      fechas<-colnames(clinics.new)[grepl("DO|date", colnames(clinics.new))]
    +      varTypes<-rep("Date",length(fechas))
    +      names(varTypes)<-fechas
    +      for (i in fechas){
    +        clinics.new[,i]<-as.Date(clinics.new[,i])
    +      }
    +      sqlSave(conn, clinics.new, tablename="CLINICS", append = T, varTypes = varTypes)
    +      print("Tabla CLINICS sincronizada.")
         }
    -    sqlSave(conn, clinics.new, tablename="CLINICS", append = T, varTypes = varTypes)
    -    print("Tabla CLINICS sincronizada.")
       }
    +  if (dbtype == "UM"){
    +    nsamples.clin<-sqlFetch(conn, "CLINICOS") %>% nrow
    +    umid.new<-upd.clinics$UMID[!upd.clinics$UMID %in% (sqlFetch(conn, "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:
    +    if (sinc.clinics){
    +      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]<-as.Date(clinics.new[,i])
    +      }
    +      sqlSave(conn, clinics.new, tablename="CLINICOS", append = T, varTypes = varTypes)
    +      print("Tabla CLINICOS sincronizada.")
    +    }
    +  }
    +}
    +
    +
    + +
    +

    sqlMultiSamples

    +
    +

    Description

    +

    Prints a table compiling information about laboratory samples, scRNAseq samples and RNA/DNA samples.

    +
    +
    +

    Usage

    +

    sqlMultiSamples(kbl=F, NHC=F, full=F)

    +
    +
    +

    Arguments

    + ++++ + + + + + + + + + + + + + + + + + + + + +
    ArgumentDescription
    kblformats the output table with the kableEstra style. Defaults to F.
    NHCadds the NHC to the table in addition to the UMID. Defaults to F.
    fullprints also the patients that doesn’t appear in the MUESTRAS table. Defaults to F.
    +
    +
    +

    Details

    +

    Prints a table compiling information about laboratory samples, scRNAseq samples and RNA/DNA samples.

    +
    +
    +

    Value

    +

    A data.frame or a kableExtra table.

    +
    +
    +

    Examples

    +
    dta<-odbcConnect("test")
    +sqlMultiSamples()
    +
    +
    +

    Function

    +
    sqlMultiSamples<-function(kbl=F, NHC=F, full=F){
    +  query<-sqlQuery(dta, "SELECT U.UMID,U.NHC,M.FECHA_RECEPCION,M.TIPO,M.CODIGO,C.CODIGO,R.CODIGO,R.ESTADO 
    +         FROM ((UMID U
    +         LEFT OUTER JOIN MUESTRAS M ON U.UMID=M.UMID)
    +         LEFT OUTER JOIN CNAG C ON M.CODIGO=C.CODIGO)
    +         LEFT OUTER JOIN RNADNA R ON M.CODIGO=R.CODIGO") %>% rename("CNAG"="CODIGO.1","RNADNA"="CODIGO.2")
    +  
    +  if (full==F){query<- query %>% filter(!is.na(CODIGO))}
    +  if (NHC==F){query<- query %>% select(-NHC)}
    +  
    +  query<-query %>% mutate(
    +    CNAG=case_when(!is.na(CNAG)~"X",TRUE~""),
    +    RNADNA=case_when((!is.na(RNADNA) & (ESTADO=="ENV"))~"X",
    +                     (!is.na(RNADNA) & (is.na(ESTADO)))~".",
    +                     TRUE~"")
    +  ) %>% select(-ESTADO)
    +  if (kbl==T){
    +    query %>% kableExtra::kbl() %>% kableExtra::kable_styling(full_width = F, bootstrap_options = c("striped"))
    +  }else{
    +    return(query)
    +    }
     }
    From 8c8065fe9d615ee6496bac19c515b57939a59e69 Mon Sep 17 00:00:00 2001 From: Costa <47926492N@ICO.SCS.local> Date: Mon, 20 Dec 2021 16:17:37 +0100 Subject: [PATCH 8/9] =?UTF-8?q?Corregido=20el=20error=20en=20el=20que=20no?= =?UTF-8?q?=20hab=C3=ADa=20pacientes=20nuevos=20en=20la=20funci=C3=B3n=20s?= =?UTF-8?q?qlGenOVID.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- sqlFunctions.R | 46 +++++++++++++++++++++++++--------------------- 1 file changed, 25 insertions(+), 21 deletions(-) diff --git a/sqlFunctions.R b/sqlFunctions.R index a0b91fb..c13e39e 100644 --- a/sqlFunctions.R +++ b/sqlFunctions.R @@ -74,27 +74,31 @@ sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL){ dbid<-sqlFetch(conn,db["dbcode"]) new.nhc<-nhcs[!nhcs %in% dbid$NHC] - next.num<-gsub(db["dbcode"],"",dbid[,db["dbcode"]]) %>% as.numeric %>% max(na.rm=T)+1 - last.num<-next.num+(length(new.nhc)-1) - newtab<-data.frame("NHC"=new.nhc, "ID"=sprintf("%s%04d",db["dbcode"],next.num:last.num)) %>% rename(!!db["dbcode"]:="ID") - if(dbtype=="OV"){ - dbid<-rbind(dbid,newtab) - } - if(dbtype=="UM"){ - dbid<-merge(dbid, newtab, all=T) %>% select(Id,NHC,UMID) %>% arrange(Id) - dbid$Id<-as.numeric(rownames(dbid)) - dbid$NHC<-as.numeric(dbid$NHC) - } - rownames(dbid)<-as.character(1:nrow(dbid)) - dbid<-filter(dbid, NHC %in% new.nhc) %>% mutate(NHC=as.character(NHC)) - - if (sinc){ - ### !! Atención, esto cambia la base de datos: - sqlSave(conn, dbid, tablename=db["dbcode"], append = T) - print("La base ha sido actualizada.") - } - if (verb){ - return(dbid) + if(length(new.nhc) > 0){ + next.num<-gsub(db["dbcode"],"",dbid[,db["dbcode"]]) %>% as.numeric %>% max(na.rm=T)+1 + last.num<-next.num+(length(new.nhc)-1) + newtab<-data.frame("NHC"=new.nhc, "ID"=sprintf("%s%04d",db["dbcode"],next.num:last.num)) %>% rename(!!db["dbcode"]:="ID") + if(dbtype=="OV"){ + dbid<-rbind(dbid,newtab) + } + if(dbtype=="UM"){ + dbid<-merge(dbid, newtab, all=T) %>% select(Id,NHC,UMID) %>% arrange(Id) + dbid$Id<-as.numeric(rownames(dbid)) + dbid$NHC<-as.numeric(dbid$NHC) + } + rownames(dbid)<-as.character(1:nrow(dbid)) + dbid<-filter(dbid, NHC %in% new.nhc) %>% mutate(NHC=as.character(NHC)) + + if (sinc){ + ### !! Atención, esto cambia la base de datos: + sqlSave(conn, dbid, tablename=db["dbcode"], append = T) + print("La base ha sido actualizada.") + } + if (verb){ + return(dbid) + } + }else{ + print("No hay pacientes nuevos.") } } From 3b8a4c0657324ecf2ad657b183fd746a485b6b22 Mon Sep 17 00:00:00 2001 From: Costa <47926492N@ICO.SCS.local> Date: Mon, 24 Jan 2022 14:58:07 +0100 Subject: [PATCH 9/9] Correcting some workflow positions. Changing sqlDropLast to sqlLastDrop to avoid errors with sqlDrop. --- Docs/sqlFunctions-doc.Rmd | 6 +++--- sqlFunctions.R | 2 +- workflow.R | 6 +++--- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/Docs/sqlFunctions-doc.Rmd b/Docs/sqlFunctions-doc.Rmd index 5f00f51..e7e5544 100644 --- a/Docs/sqlFunctions-doc.Rmd +++ b/Docs/sqlFunctions-doc.Rmd @@ -18,7 +18,7 @@ knitr::opts_chunk$set(echo = TRUE) Removes from Database the last (or the amount specified) entry. ### Usage -sqlDropLast(conn, tablename, droplast=1, dbtype=NULL) +sqlLastDrop(conn, tablename, droplast=1, dbtype=NULL) ### Arguments Argument|Description @@ -37,12 +37,12 @@ Invisibly for success (and failures cause errors). ### Examples ```r dta<-odbcConnect("test") -sqlDropLast(dta, "TableTest") +sqlLastDrop(dta, "TableTest") ``` ### Function ```r -sqlDropLast<-function(conn, tablename, droplast=1,dbtype=NULL){ +sqlLastDrop<-function(conn, tablename, droplast=1,dbtype=NULL){ if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} diff --git a/sqlFunctions.R b/sqlFunctions.R index c13e39e..5de1ca1 100644 --- a/sqlFunctions.R +++ b/sqlFunctions.R @@ -1,6 +1,6 @@ require(RODBC) -sqlDropLast<-function(conn, tablename, droplast=1,dbtype=NULL){ +sqlLastDrop<-function(conn, tablename, droplast=1,dbtype=NULL){ if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} diff --git a/workflow.R b/workflow.R index c474b60..af7c49f 100644 --- a/workflow.R +++ b/workflow.R @@ -6,13 +6,13 @@ sqlInitialize() ## Asegurarse de que la variable file sea la que nos corresponde: file -# Crear copia de seguridad -sqlBackUp() - # Inicializar conexión dta<-odbcConnectAccess2007(access.file = file, pwd = .rs.askForPassword("Enter password:")) +# Crear copia de seguridad +sqlBackUp() + ## Importamos los NHC de las muestras nuevas nhc.test<-read.xlsx("queryOV.xlsx", sheet = "NHC") %>% pull(NHC)