Limpieza de código.

ruta_database.R

@@ -1 +1,4 @@
-file<-"C:/Users/47926492N/OneDrive - IDIBELL - Institut d'Investigació Biomèdica de Bellvitge/RATG-PIULATS/OVARIO.accdb"
+# file<-"C:/Users/47926492N/OneDrive - IDIBELL - Institut d'Investigació Biomèdica de Bellvitge/RATG-PIULATS/MELANOMA UVEAL CIT.accdb"
+# file<-"C:/Users/47926492N/OneDrive - IDIBELL - Institut d'Investigació Biomèdica de Bellvitge/RATG-PIULATS/OVARIO.accdb"
+UMfile<-file<-"C:/Users/47926492N/Documents/Test/MELANOMA UVEAL CIT.accdb"
+OVfile<-file<-"C:/Users/47926492N/Documents/Test/OVARIO.accdb"

sqlFunctions.R

@@ -13,20 +13,23 @@ sqlLastDrop<-function(conn, tablename, droplast=1,dbtype=NULL){
     sqlSave(conn, table, tablename = tablename, safer = F)}
 }
 
-sqlInitialize<-function(){
+
-  library(tidyverse)
+sqlInitialize<-function(ruta="ruta_database.R"){
+  # library(tidyverse)
   library(RODBC)
   library(openxlsx)
   
   ## Conexión a la base de datos
-  source("ruta_database.R", encoding = "UTF-8")
+  source(ruta, encoding = "UTF-8")
 }
 
 sqlBackUp<-function(dbfile=file,conn=dta,bu.dir=NULL){
+  print(dbfile)
   if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){bu.dir<-"BU_UM"}
   if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){bu.dir<-"BU_OVARIO"}
   
-  db=strsplit(dbfile, "/")[[1]]%>% tail(n=1)
+  db=tail(strsplit(dbfile, "/")[[1]], n=1)
+  print(db)
   bu_path<-gsub(db,bu.dir,dbfile)
   if (!dir.exists(bu_path)){
     dir.create(bu_path)
@@ -54,36 +57,46 @@ sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F, dbtype=NULL){
   if (isFALSE(verb)){
     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)
+      merge(data.frame(NHC=nhcs),all=T) %>% mutate(NHC=factor(NHC,levels = unique(nhcs))) %>% arrange(NHC)
   }else{
     sqlQuery(conn, query) %>% filter(NHC %in% nhcs)
   }
 }
 
 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(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
-  if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
+  if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
   
   if (dbtype == "OV"){
-    db<-c("dbcode"="OVID")
+    db<-c("dbcode"="OVID", "dbpref"="OVID")
   }
   if (dbtype == "UM"){
-    db<-c("dbcode"="UMID")
+    db<-c("dbcode"="UMID","dbpref"="UMID")
+  }
+  if (dbtype == "CC"){
+    db<-c("dbcode"="PATID", "dbpref"="CCID")
   }
   
-  dbid<-sqlFetch(conn,db["dbcode"])
+  dbid<-sqlFetch(conn,db["dbcode"], as.is=T)
+  new.nhc<-nhcs[!nhcs %in% dbid$NHC] %>% unique()
 
-  new.nhc<-nhcs[!nhcs %in% dbid$NHC]
   if(length(new.nhc) > 0){
-    next.num<-gsub(db["dbcode"],"",dbid[,db["dbcode"]]) %>% as.numeric %>% max(na.rm=T)+1
+    if (nrow(dbid) == 0){next.num<-1}else{
+    next.num<-gsub(db["dbpref"],"",dbid[,db["dbcode"]]) %>% as.numeric %>% max(na.rm=T)+1
+    }
+    print(next.num)
     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")
+    newtab<-data.frame("NHC"=new.nhc, "ID"=sprintf("%s%04d",db["dbpref"],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<-merge(dbid, newtab, all=T) %>% select(NHC,UMID) %>% arrange(UMID)
-      dbid$Id<-as.numeric(rownames(dbid))
+      # dbid$Id<-as.numeric(rownames(dbid))
+      # dbid$NHC<-dbid$NHC
+    }
+    if (dbtype=="CC"){
+      dbid<-merge(dbid, newtab, all=T) %>% select(NHC,PATID) %>% arrange(PATID)
       dbid$NHC<-as.numeric(dbid$NHC)
     }
     rownames(dbid)<-as.character(1:nrow(dbid))
@@ -91,7 +104,7 @@ sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL){
     
     if (sinc){
       ### !! Atención, esto cambia la base de datos:
-      sqlSave(conn, dbid, tablename=db["dbcode"], append = T)
+      sqlSave(conn, dbid, tablename=db["dbcode"], append = T, rownames = F)
       print("La base ha sido actualizada.")
     }
     if (verb){
@@ -102,7 +115,7 @@ sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL){
   }
 }
 
-sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T, dbtype=NULL){
+sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T, dbtype=NULL, today=F){
   if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
   if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
   
@@ -150,24 +163,51 @@ sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod
       }
       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))
+      new.samp.df<-data.frame("NHC"=nhcs, "CODIGO"=new.samp) %>% merge(sqlFetch(dta,"UMID"), all.x=T) %>% arrange(CODIGO)
       samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO)
+      if (today==TRUE){
+        samples.exp$FECHA_RECEPCION<-format(Sys.Date(), "%d/%m/%y")
+      }
     }
     
+    nhc.table<-read.xlsx(file, sheet = "NHC")
+    
+    if (any(sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]) == T)){
+      nhcs.cnag<-nhc.table[sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]),"NHC"]
+      umid.cnag<-sqlFetch(conn, "UMID") %>% filter(NHC %in% nhcs.cnag) %>% pull(UMID)
+      sample.cnag<-samples.exp %>% filter(UMID %in% umid.cnag) %>% pull(CODIGO)
+      cnag.exp<-merge(data.frame("UMID"=umid.cnag, "CODIGO"=sample.cnag), sqlFetch(dta, "CNAG") %>% slice(0), all=T)
+      if (today==TRUE){
+        cnag.exp$FECHA_ENVIO<-format(Sys.Date(), "%d/%m/%y")
+      }
+    }else{cnag.exp<-sqlFetch(dta, "CNAG") %>% slice(0)}
+    if (any(sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]) == T)){
+      nhcs.rna<-nhc.table[sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]),"NHC"]
+      umid.rna<-sqlFetch(conn, "UMID") %>% filter(NHC %in% nhcs.rna) %>% pull(UMID)
+      sample.rna<-samples.exp %>% filter(UMID %in% umid.rna) %>% pull(CODIGO)
+      rna.exp<-merge(data.frame("UMID"=umid.rna, "CODIGO"=sample.rna), sqlFetch(dta, "RNADNA") %>% slice(0), all=T)
+    }else{rna.exp<- sqlFetch(dta, "RNADNA") %>% slice(0)}
     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<-merge(umid.new,upd.clinics, all.x=T, by="UMID")
       upd.clinics$NHC<-as.character(upd.clinics$NHC)
       for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])}
     }
     
     ## Exportar tablas a la plantilla de entrada para su rellenado
-    wb <- loadWorkbook(file)
+    wb <- createWorkbook(file)
-    writeData(wb, "NHC", upd.umid)
+    addWorksheet(wb, "NHC")
+    addWorksheet(wb, "samples")
+    addWorksheet(wb, "CLINICS")
+    addWorksheet(wb, "CNAG")
+    addWorksheet(wb, "RNADNA")
+    writeData(wb, "NHC", merge(nhc.table, upd.umid, sort = F))
     if (samples.mod){writeData(wb,"samples",samples.exp)}
     if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)}
+    writeData(wb,"CNAG",cnag.exp)
+    writeData(wb,"RNADNA",rna.exp)
     saveWorkbook(wb,file,overwrite = TRUE)
   }
 }
@@ -238,7 +278,7 @@ sqlSincBD<-function(conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clin
       for (i in fechas){
         clinics.mod[,i]<-as.Date(clinics.mod[,i])
       }
-      sqlUpdate(conn, clinics.mod,"CLINICOS")
+      sqlUpdate(conn, clinics.mod,"CLINICOS", index="UMID")
       print("Tabla CLINICOS modificada.")
     }
   }
@@ -276,7 +316,7 @@ sqlSincBD<-function(conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clin
       for (i in fechas){
         clinics.new[,i]<-as.Date(clinics.new[,i])
       }
-      sqlSave(conn, clinics.new, tablename="CLINICOS", append = T, varTypes = varTypes)
+      sqlSave(conn, clinics.new, tablename="CLINICOS", append = T, varTypes = varTypes, rownames = F)
       print("Tabla CLINICOS sincronizada.")
     }
   }