Completar compatibilidad con MU.

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,7 +98,11 @@ 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){
+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
@@ -113,9 +134,47 @@ sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod
     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)
+  }
+}
+
+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"}
   
-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
+  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}
@@ -127,8 +186,25 @@ sqlSincBD<-function(conn=dta, filetemp="QueryOV.xlsx", sinc.samples=F, sinc.clin
       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
+  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
@@ -144,8 +220,27 @@ sqlSincBD<-function(conn=dta, filetemp="QueryOV.xlsx", sinc.samples=F, sinc.clin
       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.")
+    }
+  }
   
   ## Añadir datos clínicos nuevos a la base de datos
+  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)
@@ -163,18 +258,42 @@ sqlSincBD<-function(conn=dta, filetemp="QueryOV.xlsx", sinc.samples=F, sinc.clin
       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}
     
-sqlMultiSamples<-function(kbl=F, NHC=F){
+    ### !! Atención, esto cambia la base de datos:
-  query<-sqlQuery(dta, "SELECT M.UMID,U.NHC,M.FECHA_RECEPCION,M.CODIGO,C.CODIGO,R.CODIGO 
+    if (sinc.clinics){
-         FROM ((MUESTRAS M
+      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<-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 RNADNA R ON M.CODIGO=R.CODIGO") %>% rename("CNAG"="CODIGO.1","RNADNA"="CODIGO.2")
-         LEFT OUTER JOIN UMID U ON U.UMID=M.UMID") %>% 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{

workflow.R

@@ -1,13 +1,13 @@
-source("sqlFunctions.R")
+source("sqlFunctions.R", encoding = "UTF-8")
-
-## Asegurarse de que la variable file sea la que nos corresponde:
-file
 
 # 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,