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] 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,