require(RODBC) 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"} table<-sqlFetch(conn, tablename) table<-table[1:(nrow(table)-droplast),] 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(ruta="ruta_database.R"){ library(tidyverse) library(RODBC) library(openxlsx) ## Conexión a la base de datos source(ruta, encoding = "UTF-8") } 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){bu.dir<-"BU_OVARIO"} db=strsplit(dbfile, "/")[[1]]%>% tail(n=1) bu_path<-gsub(db,bu.dir,dbfile) if (!dir.exists(bu_path)){ dir.create(bu_path) print(paste0("Back Up directory ", bu_path, " created")) } cp_bu<-paste0(bu_path, "/", format(Sys.time(), format="%Y%m%d"),"-",db) file.copy(dbfile, cp_bu) } 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, 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 = 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(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"} if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"} 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] %>% unique() 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(NHC,UMID) %>% arrange(UMID) # 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, rownames = F) print("La base ha sido actualizada.") } if (verb){ return(dbid) } }else{ print("No hay pacientes nuevos.") } } 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"} 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])} } ## 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<-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, 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 <- createWorkbook(file) 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) } } 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"} ## 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 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", index="UMID") 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) 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, rownames = F) 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") %>% 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) } }