Generación de funciones a partir del script y creación de un ejemplo en "workflow.R".

2021-10-28 17:30:11 +02:00
parent 8b9b9b9681
commit 05962b66eb
3 changed files with 147 additions and 1 deletions
@@ -56,7 +56,7 @@ last.samp<-next.samp+(length(nhc.test)-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"=nhc.test)), data.frame("NHC"=nhc.test, "samples"=new.samp))
 samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples)
-samples.exp[is.na(samples.exp)]<-""
+# samples.exp[is.na(samples.exp)]<-""

 ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
 upd.clinics<-sqlFetch(dta, "CLINICS")
@@ -5,3 +5,129 @@ sqlDropLast<-function(conn, tablename, droplast=1){
  table<-table[1:(nrow(table)-droplast),]
  sqlSave(conn, table, tablename = tablename, safer = F)
 }
+
+sqlInitialize<-function(){
+  library(tidyverse)
+  library(RODBC)
+  library(openxlsx)
+  
+  ## Conexión a la base de datos
+  source("ruta_database.R", encoding = "UTF-8")
+}
+
+sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F){
+  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)
+  }else{
+    sqlQuery(conn, "SELECT O.NHC,S.* 
+         FROM SAMPLES S 
+         INNER JOIN OVID O 
+         ON O.OVID=S.OVID") %>% filter(NHC %in% nhcs)
+  }
+}
+
+sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F){
+  ovid<-sqlFetch(conn,"OVID")
+  
+  new.nhc<-nhcs[!nhcs %in% ovid$NHC]
+  next.num<-gsub("OVID","",ovid$OVID) %>% 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))
+  
+  if (sinc){
+    ### !! Atención, esto cambia la base de datos:
+    sqlSave(conn, upd.ovid, tablename="OVID", append = T)
+    print("La base ha sido actualizada.")
+  }
+  if (verb){
+    return(upd.ovid)
+  }
+}
+
+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
+    }
+    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)
+}
+
+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}
+  
+  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 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])
+    }
+    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])
+    }
+    sqlSave(conn, clinics.new, tablename="CLINICS", append = T, varTypes = varTypes)
+    print("Tabla CLINICS sincronizada.")
+  }
+}
@@ -0,0 +1,20 @@
+source("sqlFunctions.R")
+
+# Cargar dependencias
+sqlInitialize()
+
+# Inicializar conexión
+dta<-odbcConnectAccess2007(access.file = file, 
+                           pwd = .rs.askForPassword("Enter password:"))
+
+# Ver si ya hay muestras de los pacientes (opcional, para uno mismo)
+sqlShowSamples()
+
+# Generar código OVID para muestras nuevas
+sqlGenOVID(sinc=T)
+
+# Rellenar fichero plantilla "QueryOV.xlsx"
+sqlWriteTemp()
+
+# Sincronizar lo rellenado en las pestañas samples y clinics
+sqlSincBD(sinc.samples = T, sinc.clinics = T)