Browse Source

Correction of conflicts for merging UM to main.

Merge branch 'UM'

# Conflicts:
#	workflow.R
main
Costa 2 years ago
parent
commit
4ba729e6c6
5 changed files with 1200 additions and 395 deletions
  1. +296
    -99
      Docs/Readme.md
  2. +296
    -100
      Docs/sqlFunctions-doc.Rmd
  3. +349
    -98
      Docs/sqlFunctions-doc.html
  4. +255
    -94
      sqlFunctions.R
  5. +4
    -4
      workflow.R

+ 296
- 99
Docs/Readme.md

@ -8,6 +8,7 @@
<li><a href="#sqlgenovid">sqlGenOVID</a></li> <li><a href="#sqlgenovid">sqlGenOVID</a></li>
<li><a href="#sqlwritetemp">sqlWriteTemp</a></li> <li><a href="#sqlwritetemp">sqlWriteTemp</a></li>
<li><a href="#sqlsincbd">sqlSincBD</a></li> <li><a href="#sqlsincbd">sqlSincBD</a></li>
<li><a href="#sqlmultisamples">sqlMultiSamples</a></li>
</ul> </ul>
</div> </div>
@ -19,7 +20,7 @@
Removes from Database the last (or the amount specified) entry. Removes from Database the last (or the amount specified) entry.
### Usage ### Usage
sqlDropLast(conn, tablename, droplast=1)
sqlDropLast(conn, tablename, droplast=1, dbtype=NULL)
### Arguments ### Arguments
Argument|Description Argument|Description
@ -27,6 +28,7 @@ Argument|Description
conn|connection handle returned by odbcConnect. conn|connection handle returned by odbcConnect.
tablename|character: a database table name accessible from the connected DSN. tablename|character: a database table name accessible from the connected DSN.
droplast|the amount of lines to be removed from the table strating from tail. By default, it removes only 1 line. droplast|the amount of lines to be removed from the table strating from tail. By default, it removes only 1 line.
dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced.
### Details ### Details
Removes from Database the last (or the amount specified) entry. Removes from Database the last (or the amount specified) entry.
@ -42,10 +44,17 @@ sqlDropLast(dta, "TableTest")
### Function ### Function
```r ```r
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<-sqlFetch(conn, tablename)
table<-table[1:(nrow(table)-droplast),] 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)}
} }
``` ```
@ -94,13 +103,14 @@ sqlInitialize<-function(){
Creates a Back Up copy of the database. Creates a Back Up copy of the database.
### Usage ### Usage
sqlBackUp(dbfile=file,bu.dir="BU_OVARIO")
sqlBackUp(dbfile=file,conn=dta,bu.dir=NULL)
### Arguments ### Arguments
Argument|Description Argument|Description
---|--- ---|---
dbfile| Database File location. dbfile| Database File location.
bu.dir| Directory under the DB file where the back up will be placed.
conn|connection handle returned by odbcConnect.
bu.dir|Directory under the DB file where the back up will be placed. It defaults to NULL and is deduced from conn database.
### Details ### Details
Creates a Back Up copy of the database. It adds the date in front of the back up file. Creates a Back Up copy of the database. It adds the date in front of the back up file.
@ -116,7 +126,10 @@ sqlBackUp()
### Function ### Function
```r ```r
sqlBackUp<-function(dbfile=file,bu.dir="BU_OVARIO"){
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) db=strsplit(dbfile, "/")[[1]]%>% tail(n=1)
bu_path<-gsub(db,bu.dir,dbfile) bu_path<-gsub(db,bu.dir,dbfile)
if (!dir.exists(bu_path)){ if (!dir.exists(bu_path)){
@ -136,7 +149,7 @@ sqlBackUp<-function(dbfile=file,bu.dir="BU_OVARIO"){
Shows if there are already samples from the specified NHCs. Shows if there are already samples from the specified NHCs.
### Usage ### Usage
sqlShowSamples(conn=dta, nhcs=nhc.test, verb=F)
sqlShowSamples(conn=dta, nhcs=nhc.test, verb=F, dbtype=NULL)
### Arguments ### Arguments
Argument|Description Argument|Description
@ -144,6 +157,7 @@ Argument|Description
conn|connection handle returned by odbcConnect. conn|connection handle returned by odbcConnect.
nhcs|Character vector with the NHCs to test. nhcs|Character vector with the NHCs to test.
verb|Verbose: if TRUE, all the columns from "SAMPLES" table are printed. verb|Verbose: if TRUE, all the columns from "SAMPLES" table are printed.
dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced.
### Details ### Details
Takes the NHCs listed in the nhcs vector and checks if there are already samples from those patients. Takes the NHCs listed in the nhcs vector and checks if there are already samples from those patients.
@ -160,18 +174,27 @@ sqlShowSamples()
### Function ### Function
```r ```r
sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F){
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)){ 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)
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)
}else{ }else{
sqlQuery(conn, "SELECT O.NHC,S.*
FROM SAMPLES S
INNER JOIN OVID O
ON O.OVID=S.OVID") %>% filter(NHC %in% nhcs)
sqlQuery(conn, query) %>% filter(NHC %in% nhcs)
} }
} }
``` ```
@ -181,10 +204,10 @@ sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F){
## sqlGenOVID ## sqlGenOVID
### Description ### Description
Generates new consecutive OVID code for the patients that are not found in the DB.
Generates new consecutive OVID or UMID code for the patients that are not found in the DB.
### Usage ### Usage
sqlGenOVID(conn=dta, nhcs=nhc.test, verb=T, sinc=F)
sqlGenOVID(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL)
### Arguments ### Arguments
Argument|Description Argument|Description
@ -193,9 +216,10 @@ conn|connection handle returned by odbcConnect.
nhcs|Character vector with the NHCs to test. nhcs|Character vector with the NHCs to test.
verb|Verbose: if TRUE (default), it prints the data.frame with the generated OVID codes. verb|Verbose: if TRUE (default), it prints the data.frame with the generated OVID codes.
sinc|If TRUE (default is FALSE for security), it adds the new entries to the "OVID" table in the DB. sinc|If TRUE (default is FALSE for security), it adds the new entries to the "OVID" table in the DB.
dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced.
### Details ### Details
Generates new consecutive OVID code for the patients that are not found in the DB.
Generates new consecutive OVID or UMID code for the patients that are not found in the DB.
### Value ### Value
If verb is TRUE, it returns a data.frame. If verb is TRUE, it returns a data.frame.
@ -209,23 +233,41 @@ sqlGenOVID(sinc=T)
### Function ### Function
```r ```r
sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F){
ovid<-sqlFetch(conn,"OVID")
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"}
new.nhc<-nhcs[!nhcs %in% ovid$NHC]
next.num<-gsub("OVID","",ovid$OVID) %>% as.numeric %>% max(na.rm=T)+1
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]
next.num<-gsub(db["dbcode"],"",dbid[,db["dbcode"]]) %>% as.numeric %>% max(na.rm=T)+1
last.num<-next.num+(length(new.nhc)-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))
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(Id,NHC,UMID) %>% arrange(Id)
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){ if (sinc){
### !! Atención, esto cambia la base de datos: ### !! Atención, esto cambia la base de datos:
sqlSave(conn, upd.ovid, tablename="OVID", append = T)
sqlSave(conn, dbid, tablename=db["dbcode"], append = T)
print("La base ha sido actualizada.") print("La base ha sido actualizada.")
} }
if (verb){ if (verb){
return(upd.ovid)
return(dbid)
} }
} }
``` ```
@ -235,10 +277,10 @@ sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F){
## sqlWriteTemp ## sqlWriteTemp
### Description ### Description
Fills the Query Template file with the OVID and OV newly generated codes.
Fills the Query Template file with the OVID or UMID and OV or UM newly generated codes.
### Usage ### Usage
sqlWriteTemp(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T)
sqlWriteTemp(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T, dbtype=NULL)
### Arguments ### Arguments
Argument|Description Argument|Description
@ -248,9 +290,10 @@ nhcs|Character vector with the NHCs to test.
file|Template file that will be used to interact with the DB. file|Template file that will be used to interact with the DB.
samples.mod|If TRUE (default), it fills the "samples" template sheet. samples.mod|If TRUE (default), it fills the "samples" template sheet.
clinics.mod|If TRUE (default), it fills the "CLINICS" template sheet. clinics.mod|If TRUE (default), it fills the "CLINICS" template sheet.
dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced.
### Details ### Details
Fills the Query Template file with the OVID and OV newly generated codes. It is required that the DB has been updated with the sqlGenOVID function. It replaces previous content in the template file sheets that are filled. In the case of "CLINICS" table, if there were already an entry in the DB for that OVID code, the template file is filled with that information.
Fills the Query Template file with the OVID and OV or UMID and UM newly generated codes. It is required that the DB has been updated with the sqlGenOVID function. It replaces previous content in the template file sheets that are filled. In the case of "CLINICS" table, if there were already an entry in the DB for that OVID/UMID code, the template file is filled with that information.
### Value ### Value
Invisibly for success (and failures cause errors). Invisibly for success (and failures cause errors).
@ -265,37 +308,74 @@ sqlWriteTemp()
### Function ### Function
```r ```r
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)
} }
``` ```
@ -307,7 +387,7 @@ sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod
Updates the DB with the information filled in the template file. Updates the DB with the information filled in the template file.
### Usage ### Usage
sqlSincBD(conn=dta, filetemp="QueryOV.xlsx", sinc.samples=F, sinc.clinics=F)
sqlSincBD(conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clinics=F, dbtype=NULL)
### Arguments ### Arguments
Argument|Description Argument|Description
@ -316,6 +396,7 @@ conn|connection handle returned by odbcConnect.
filetemp|Template file that will be used to interact with the DB. filetemp|Template file that will be used to interact with the DB.
sinc.samples|If TRUE (default is FALSE for security), it updates the SAMPLES table in the DB with the information in the "samples" template sheet. sinc.samples|If TRUE (default is FALSE for security), it updates the SAMPLES table in the DB with the information in the "samples" template sheet.
clinics.mod|If TRUE (default is FALSE for security), it updates the CLINICS table in the DB with the information in the "CLINICS" template sheet. clinics.mod|If TRUE (default is FALSE for security), it updates the CLINICS table in the DB with the information in the "CLINICS" template sheet.
dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced.
### Details ### Details
Updates the DB with the information filled in the template file. All the "samples" entries are added as new rows (as all samples are new even if the patient was already in the DB). The new patients included in the "CLINICS" sheet are introduced in the DB as new rows and the ones that were already there are modified in its previous row location. Updates the DB with the information filled in the template file. All the "samples" entries are added as new rows (as all samples are new even if the patient was already in the DB). The new patients included in the "CLINICS" sheet are introduced in the DB as new rows and the ones that were already there are modified in its previous row location.
@ -334,52 +415,168 @@ sqlSincBD(sinc.samples=T, sinc.clinics=T)
### Function ### Function
```r ```r
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)
### !! 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 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 ## 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 ## 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
### Description
Prints a table compiling information about laboratory samples, scRNAseq samples and RNA/DNA samples.
### Usage
sqlMultiSamples(kbl=F, NHC=F, full=F)
### Arguments
Argument|Description
---|---
kbl|formats the output table with the kableEstra style. Defaults to F.
NHC|adds the NHC to the table in addition to the UMID. Defaults to F.
full|prints also the patients that doesn't appear in the MUESTRAS table. Defaults to F.
### Details
Prints a table compiling information about laboratory samples, scRNAseq samples and RNA/DNA samples.
### Value
A data.frame or a kableExtra table.
### Examples
```r
dta<-odbcConnect("test")
sqlMultiSamples()
```
### Function
```r
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)
}
}
```

+ 296
- 100
Docs/sqlFunctions-doc.Rmd

@ -18,7 +18,7 @@ knitr::opts_chunk$set(echo = TRUE)
Removes from Database the last (or the amount specified) entry. Removes from Database the last (or the amount specified) entry.
### Usage ### Usage
sqlDropLast(conn, tablename, droplast=1)
sqlLastDrop(conn, tablename, droplast=1, dbtype=NULL)
### Arguments ### Arguments
Argument|Description Argument|Description
@ -26,6 +26,7 @@ Argument|Description
conn|connection handle returned by odbcConnect. conn|connection handle returned by odbcConnect.
tablename|character: a database table name accessible from the connected DSN. tablename|character: a database table name accessible from the connected DSN.
droplast|the amount of lines to be removed from the table strating from tail. By default, it removes only 1 line. droplast|the amount of lines to be removed from the table strating from tail. By default, it removes only 1 line.
dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced.
### Details ### Details
Removes from Database the last (or the amount specified) entry. Removes from Database the last (or the amount specified) entry.
@ -36,15 +37,22 @@ Invisibly for success (and failures cause errors).
### Examples ### Examples
```r ```r
dta<-odbcConnect("test") dta<-odbcConnect("test")
sqlDropLast(dta, "TableTest")
sqlLastDrop(dta, "TableTest")
``` ```
### Function ### Function
```r ```r
sqlDropLast<-function(conn, tablename, droplast=1){
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<-sqlFetch(conn, tablename)
table<-table[1:(nrow(table)-droplast),] 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)}
} }
``` ```
@ -93,13 +101,14 @@ sqlInitialize<-function(){
Creates a Back Up copy of the database. Creates a Back Up copy of the database.
### Usage ### Usage
sqlBackUp(dbfile=file,bu.dir="BU_OVARIO")
sqlBackUp(dbfile=file,conn=dta,bu.dir=NULL)
### Arguments ### Arguments
Argument|Description Argument|Description
---|--- ---|---
dbfile| Database File location. dbfile| Database File location.
bu.dir| Directory under the DB file where the back up will be placed.
conn|connection handle returned by odbcConnect.
bu.dir|Directory under the DB file where the back up will be placed. It defaults to NULL and is deduced from conn database.
### Details ### Details
Creates a Back Up copy of the database. It adds the date in front of the back up file. Creates a Back Up copy of the database. It adds the date in front of the back up file.
@ -115,7 +124,10 @@ sqlBackUp()
### Function ### Function
```r ```r
sqlBackUp<-function(dbfile=file,bu.dir="BU_OVARIO"){
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) db=strsplit(dbfile, "/")[[1]]%>% tail(n=1)
bu_path<-gsub(db,bu.dir,dbfile) bu_path<-gsub(db,bu.dir,dbfile)
if (!dir.exists(bu_path)){ if (!dir.exists(bu_path)){
@ -135,7 +147,7 @@ sqlBackUp<-function(dbfile=file,bu.dir="BU_OVARIO"){
Shows if there are already samples from the specified NHCs. Shows if there are already samples from the specified NHCs.
### Usage ### Usage
sqlShowSamples(conn=dta, nhcs=nhc.test, verb=F)
sqlShowSamples(conn=dta, nhcs=nhc.test, verb=F, dbtype=NULL)
### Arguments ### Arguments
Argument|Description Argument|Description
@ -143,6 +155,7 @@ Argument|Description
conn|connection handle returned by odbcConnect. conn|connection handle returned by odbcConnect.
nhcs|Character vector with the NHCs to test. nhcs|Character vector with the NHCs to test.
verb|Verbose: if TRUE, all the columns from "SAMPLES" table are printed. verb|Verbose: if TRUE, all the columns from "SAMPLES" table are printed.
dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced.
### Details ### Details
Takes the NHCs listed in the nhcs vector and checks if there are already samples from those patients. Takes the NHCs listed in the nhcs vector and checks if there are already samples from those patients.
@ -159,18 +172,27 @@ sqlShowSamples()
### Function ### Function
```r ```r
sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F){
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)){ 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)
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)
}else{ }else{
sqlQuery(conn, "SELECT O.NHC,S.*
FROM SAMPLES S
INNER JOIN OVID O
ON O.OVID=S.OVID") %>% filter(NHC %in% nhcs)
sqlQuery(conn, query) %>% filter(NHC %in% nhcs)
} }
} }
``` ```
@ -180,10 +202,10 @@ sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F){
## sqlGenOVID ## sqlGenOVID
### Description ### Description
Generates new consecutive OVID code for the patients that are not found in the DB.
Generates new consecutive OVID or UMID code for the patients that are not found in the DB.
### Usage ### Usage
sqlGenOVID(conn=dta, nhcs=nhc.test, verb=T, sinc=F)
sqlGenOVID(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL)
### Arguments ### Arguments
Argument|Description Argument|Description
@ -192,9 +214,10 @@ conn|connection handle returned by odbcConnect.
nhcs|Character vector with the NHCs to test. nhcs|Character vector with the NHCs to test.
verb|Verbose: if TRUE (default), it prints the data.frame with the generated OVID codes. verb|Verbose: if TRUE (default), it prints the data.frame with the generated OVID codes.
sinc|If TRUE (default is FALSE for security), it adds the new entries to the "OVID" table in the DB. sinc|If TRUE (default is FALSE for security), it adds the new entries to the "OVID" table in the DB.
dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced.
### Details ### Details
Generates new consecutive OVID code for the patients that are not found in the DB.
Generates new consecutive OVID or UMID code for the patients that are not found in the DB.
### Value ### Value
If verb is TRUE, it returns a data.frame. If verb is TRUE, it returns a data.frame.
@ -208,23 +231,41 @@ sqlGenOVID(sinc=T)
### Function ### Function
```r ```r
sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F){
ovid<-sqlFetch(conn,"OVID")
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"}
new.nhc<-nhcs[!nhcs %in% ovid$NHC]
next.num<-gsub("OVID","",ovid$OVID) %>% as.numeric %>% max(na.rm=T)+1
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]
next.num<-gsub(db["dbcode"],"",dbid[,db["dbcode"]]) %>% as.numeric %>% max(na.rm=T)+1
last.num<-next.num+(length(new.nhc)-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))
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(Id,NHC,UMID) %>% arrange(Id)
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){ if (sinc){
### !! Atención, esto cambia la base de datos: ### !! Atención, esto cambia la base de datos:
sqlSave(conn, upd.ovid, tablename="OVID", append = T)
sqlSave(conn, dbid, tablename=db["dbcode"], append = T)
print("La base ha sido actualizada.") print("La base ha sido actualizada.")
} }
if (verb){ if (verb){
return(upd.ovid)
return(dbid)
} }
} }
``` ```
@ -234,10 +275,10 @@ sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F){
## sqlWriteTemp ## sqlWriteTemp
### Description ### Description
Fills the Query Template file with the OVID and OV newly generated codes.
Fills the Query Template file with the OVID or UMID and OV or UM newly generated codes.
### Usage ### Usage
sqlWriteTemp(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T)
sqlWriteTemp(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T, dbtype=NULL)
### Arguments ### Arguments
Argument|Description Argument|Description
@ -247,9 +288,10 @@ nhcs|Character vector with the NHCs to test.
file|Template file that will be used to interact with the DB. file|Template file that will be used to interact with the DB.
samples.mod|If TRUE (default), it fills the "samples" template sheet. samples.mod|If TRUE (default), it fills the "samples" template sheet.
clinics.mod|If TRUE (default), it fills the "CLINICS" template sheet. clinics.mod|If TRUE (default), it fills the "CLINICS" template sheet.
dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced.
### Details ### Details
Fills the Query Template file with the OVID and OV newly generated codes. It is required that the DB has been updated with the sqlGenOVID function. It replaces previous content in the template file sheets that are filled. In the case of "CLINICS" table, if there were already an entry in the DB for that OVID code, the template file is filled with that information.
Fills the Query Template file with the OVID and OV or UMID and UM newly generated codes. It is required that the DB has been updated with the sqlGenOVID function. It replaces previous content in the template file sheets that are filled. In the case of "CLINICS" table, if there were already an entry in the DB for that OVID/UMID code, the template file is filled with that information.
### Value ### Value
Invisibly for success (and failures cause errors). Invisibly for success (and failures cause errors).
@ -264,37 +306,74 @@ sqlWriteTemp()
### Function ### Function
```r ```r
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)
} }
``` ```
@ -306,7 +385,7 @@ sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod
Updates the DB with the information filled in the template file. Updates the DB with the information filled in the template file.
### Usage ### Usage
sqlSincBD(conn=dta, filetemp="QueryOV.xlsx", sinc.samples=F, sinc.clinics=F)
sqlSincBD(conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clinics=F, dbtype=NULL)
### Arguments ### Arguments
Argument|Description Argument|Description
@ -315,6 +394,7 @@ conn|connection handle returned by odbcConnect.
filetemp|Template file that will be used to interact with the DB. filetemp|Template file that will be used to interact with the DB.
sinc.samples|If TRUE (default is FALSE for security), it updates the SAMPLES table in the DB with the information in the "samples" template sheet. sinc.samples|If TRUE (default is FALSE for security), it updates the SAMPLES table in the DB with the information in the "samples" template sheet.
clinics.mod|If TRUE (default is FALSE for security), it updates the CLINICS table in the DB with the information in the "CLINICS" template sheet. clinics.mod|If TRUE (default is FALSE for security), it updates the CLINICS table in the DB with the information in the "CLINICS" template sheet.
dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced.
### Details ### Details
Updates the DB with the information filled in the template file. All the "samples" entries are added as new rows (as all samples are new even if the patient was already in the DB). The new patients included in the "CLINICS" sheet are introduced in the DB as new rows and the ones that were already there are modified in its previous row location. Updates the DB with the information filled in the template file. All the "samples" entries are added as new rows (as all samples are new even if the patient was already in the DB). The new patients included in the "CLINICS" sheet are introduced in the DB as new rows and the ones that were already there are modified in its previous row location.
@ -333,52 +413,168 @@ sqlSincBD(sinc.samples=T, sinc.clinics=T)
### Function ### Function
```r ```r
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)
### !! 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 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 ## 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 ## 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
### Description
Prints a table compiling information about laboratory samples, scRNAseq samples and RNA/DNA samples.
### Usage
sqlMultiSamples(kbl=F, NHC=F, full=F)
### Arguments
Argument|Description
---|---
kbl|formats the output table with the kableEstra style. Defaults to F.
NHC|adds the NHC to the table in addition to the UMID. Defaults to F.
full|prints also the patients that doesn't appear in the MUESTRAS table. Defaults to F.
### Details
Prints a table compiling information about laboratory samples, scRNAseq samples and RNA/DNA samples.
### Value
A data.frame or a kableExtra table.
### Examples
```r
dta<-odbcConnect("test")
sqlMultiSamples()
```
### Function
```r
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)
}
}
```

+ 349
- 98
Docs/sqlFunctions-doc.html

@ -176,6 +176,7 @@ pre code {
<li><a href="#sqlgenovid">sqlGenOVID</a></li> <li><a href="#sqlgenovid">sqlGenOVID</a></li>
<li><a href="#sqlwritetemp">sqlWriteTemp</a></li> <li><a href="#sqlwritetemp">sqlWriteTemp</a></li>
<li><a href="#sqlsincbd">sqlSincBD</a></li> <li><a href="#sqlsincbd">sqlSincBD</a></li>
<li><a href="#sqlmultisamples">sqlMultiSamples</a></li>
</ul> </ul>
</div> </div>
@ -188,7 +189,7 @@ pre code {
</div> </div>
<div id="usage" class="section level3"> <div id="usage" class="section level3">
<h3>Usage</h3> <h3>Usage</h3>
<p>sqlDropLast(conn, tablename, droplast=1)</p>
<p>sqlDropLast(conn, tablename, droplast=1, dbtype=NULL)</p>
</div> </div>
<div id="arguments" class="section level3"> <div id="arguments" class="section level3">
<h3>Arguments</h3> <h3>Arguments</h3>
@ -216,6 +217,10 @@ pre code {
<td>droplast</td> <td>droplast</td>
<td>the amount of lines to be removed from the table strating from tail. By default, it removes only 1 line.</td> <td>the amount of lines to be removed from the table strating from tail. By default, it removes only 1 line.</td>
</tr> </tr>
<tr class="even">
<td>dbtype</td>
<td>used to manually specify the database type. It defaults to NULL and the type is deduced.</td>
</tr>
</tbody> </tbody>
</table> </table>
</div> </div>
@ -234,10 +239,17 @@ sqlDropLast(dta, "TableTest")
</div> </div>
<div id="function" class="section level3"> <div id="function" class="section level3">
<h3>Function</h3> <h3>Function</h3>
<pre class="r"><code>sqlDropLast&lt;-function(conn, tablename, droplast=1){
<pre class="r"><code>sqlDropLast&lt;-function(conn, tablename, droplast=1,dbtype=NULL){
if(sqlTables(conn) %&gt;% filter(TABLE_NAME == &quot;UMID&quot;) %&gt;% nrow &gt; 0){dbtype&lt;-&quot;UM&quot;}
if(sqlTables(conn) %&gt;% filter(TABLE_NAME == &quot;OVID&quot;) %&gt;% nrow &gt; 0){dbtype&lt;-&quot;OV&quot;}
table&lt;-sqlFetch(conn, tablename) table&lt;-sqlFetch(conn, tablename)
table&lt;-table[1:(nrow(table)-droplast),] table&lt;-table[1:(nrow(table)-droplast),]
sqlSave(conn, table, tablename = tablename, safer = F)
if (dbtype == &quot;OV&quot;){sqlSave(conn, table, tablename = tablename, safer = F)}
if (dbtype == &quot;UM&quot;){
sqlDrop(conn, tablename)
sqlSave(conn, table, tablename = tablename, safer = F)}
}</code></pre> }</code></pre>
<hr /> <hr />
</div> </div>
@ -298,11 +310,15 @@ sqlDropLast(dta, "TableTest")
</div> </div>
<div id="usage-2" class="section level3"> <div id="usage-2" class="section level3">
<h3>Usage</h3> <h3>Usage</h3>
<p>sqlBackUp(dbfile=file,bu.dir=“BU_OVARIO”)</p>
<p>sqlBackUp(dbfile=file,conn=dta,bu.dir=NULL)</p>
</div> </div>
<div id="arguments-2" class="section level3"> <div id="arguments-2" class="section level3">
<h3>Arguments</h3> <h3>Arguments</h3>
<table> <table>
<colgroup>
<col width="50%" />
<col width="50%" />
</colgroup>
<thead> <thead>
<tr class="header"> <tr class="header">
<th>Argument</th> <th>Argument</th>
@ -315,8 +331,12 @@ sqlDropLast(dta, "TableTest")
<td>Database File location.</td> <td>Database File location.</td>
</tr> </tr>
<tr class="even"> <tr class="even">
<td>conn</td>
<td>connection handle returned by odbcConnect.</td>
</tr>
<tr class="odd">
<td>bu.dir</td> <td>bu.dir</td>
<td>Directory under the DB file where the back up will be placed.</td>
<td>Directory under the DB file where the back up will be placed. It defaults to NULL and is deduced from conn database.</td>
</tr> </tr>
</tbody> </tbody>
</table> </table>
@ -336,7 +356,10 @@ sqlBackUp()
</div> </div>
<div id="function-2" class="section level3"> <div id="function-2" class="section level3">
<h3>Function</h3> <h3>Function</h3>
<pre class="r"><code>sqlBackUp&lt;-function(dbfile=file,bu.dir=&quot;BU_OVARIO&quot;){
<pre class="r"><code>sqlBackUp&lt;-function(dbfile=file,conn=dta,bu.dir=NULL){
if(sqlTables(conn) %&gt;% filter(TABLE_NAME == &quot;UMID&quot;) %&gt;% nrow &gt; 0){bu.dir&lt;-&quot;BU_UM&quot;}
if(sqlTables(conn) %&gt;% filter(TABLE_NAME == &quot;OVID&quot;) %&gt;% nrow &gt; 0){dbtype&lt;-&quot;BU_OVARIO&quot;}
db=strsplit(dbfile, &quot;/&quot;)[[1]]%&gt;% tail(n=1) db=strsplit(dbfile, &quot;/&quot;)[[1]]%&gt;% tail(n=1)
bu_path&lt;-gsub(db,bu.dir,dbfile) bu_path&lt;-gsub(db,bu.dir,dbfile)
if (!dir.exists(bu_path)){ if (!dir.exists(bu_path)){
@ -357,11 +380,15 @@ sqlBackUp()
</div> </div>
<div id="usage-3" class="section level3"> <div id="usage-3" class="section level3">
<h3>Usage</h3> <h3>Usage</h3>
<p>sqlShowSamples(conn=dta, nhcs=nhc.test, verb=F)</p>
<p>sqlShowSamples(conn=dta, nhcs=nhc.test, verb=F, dbtype=NULL)</p>
</div> </div>
<div id="arguments-3" class="section level3"> <div id="arguments-3" class="section level3">
<h3>Arguments</h3> <h3>Arguments</h3>
<table> <table>
<colgroup>
<col width="50%" />
<col width="50%" />
</colgroup>
<thead> <thead>
<tr class="header"> <tr class="header">
<th>Argument</th> <th>Argument</th>
@ -381,6 +408,10 @@ sqlBackUp()
<td>verb</td> <td>verb</td>
<td>Verbose: if TRUE, all the columns from “SAMPLES” table are printed.</td> <td>Verbose: if TRUE, all the columns from “SAMPLES” table are printed.</td>
</tr> </tr>
<tr class="even">
<td>dbtype</td>
<td>used to manually specify the database type. It defaults to NULL and the type is deduced.</td>
</tr>
</tbody> </tbody>
</table> </table>
</div> </div>
@ -400,18 +431,27 @@ sqlShowSamples()
</div> </div>
<div id="function-3" class="section level3"> <div id="function-3" class="section level3">
<h3>Function</h3> <h3>Function</h3>
<pre class="r"><code>sqlShowSamples&lt;-function(conn=dta, nhcs=nhc.test, verb=F){
<pre class="r"><code>sqlShowSamples&lt;-function(conn=dta, nhcs=nhc.test, verb=F, dbtype=NULL){
if(sqlTables(dta) %&gt;% filter(TABLE_NAME == &quot;UMID&quot;) %&gt;% nrow &gt; 0){dbtype&lt;-&quot;UM&quot;}
if(sqlTables(dta) %&gt;% filter(TABLE_NAME == &quot;OVID&quot;) %&gt;% nrow &gt; 0){dbtype&lt;-&quot;OV&quot;}
if (dbtype == &quot;OV&quot;){
db&lt;-c(&quot;dbtables&quot;=&quot;SAMPLES&quot;, &quot;dbcode&quot;=&quot;OVID&quot;, &quot;dbsamples&quot;=&quot;samples&quot;)
query&lt;-paste0(&quot;SELECT O.NHC,S.* FROM &quot;,db[&quot;dbtables&quot;],&quot; S INNER JOIN &quot;,db[&quot;dbcode&quot;],&quot; O ON O.&quot;,db[&quot;dbcode&quot;],&quot;=S.&quot;,db[&quot;dbcode&quot;])
}
if (dbtype == &quot;UM&quot;){
db&lt;-c(&quot;dbtables&quot;=&quot;MUESTRAS&quot;, &quot;dbcode&quot;=&quot;UMID&quot;, &quot;dbsamples&quot;=&quot;CODIGO&quot;)
query&lt;-paste0(&quot;SELECT O.NHC,S.* FROM &quot;,db[&quot;dbtables&quot;],&quot; S INNER JOIN &quot;,db[&quot;dbcode&quot;],&quot; O ON O.&quot;,db[&quot;dbcode&quot;],&quot;=S.&quot;,db[&quot;dbcode&quot;])
}
if (nrow(sqlQuery(conn, query) %&gt;% filter(NHC %in% nhcs)) == 0){
return(&quot;No hay muestras de ningún paciente.&quot;)
}
if (isFALSE(verb)){ if (isFALSE(verb)){
sqlQuery(conn, &quot;SELECT O.NHC,S.*
FROM SAMPLES S
INNER JOIN OVID O
ON O.OVID=S.OVID&quot;) %&gt;% filter(NHC %in% nhcs) %&gt;%
group_by(NHC,OVID) %&gt;% summarise(Samples=length(samples), Names=paste0(samples, collapse = &quot;;&quot;)) %&gt;% merge(data.frame(NHC=nhcs),all=T)
sqlQuery(conn, query) %&gt;% filter(NHC %in% nhcs) %&gt;%
group_by(NHC,UQ(rlang::sym(db[&quot;dbcode&quot;]))) %&gt;% summarise(Samples=length(UQ(rlang::sym(db[&quot;dbsamples&quot;]))), Names=paste0(UQ(rlang::sym(db[&quot;dbsamples&quot;])), collapse = &quot;;&quot;)) %&gt;%
merge(data.frame(NHC=nhcs),all=T) %&gt;% mutate(NHC=factor(NHC,levels = nhcs)) %&gt;% arrange(NHC)
}else{ }else{
sqlQuery(conn, &quot;SELECT O.NHC,S.*
FROM SAMPLES S
INNER JOIN OVID O
ON O.OVID=S.OVID&quot;) %&gt;% filter(NHC %in% nhcs)
sqlQuery(conn, query) %&gt;% filter(NHC %in% nhcs)
} }
}</code></pre> }</code></pre>
<hr /> <hr />
@ -421,11 +461,11 @@ sqlShowSamples()
<h2>sqlGenOVID</h2> <h2>sqlGenOVID</h2>
<div id="description-4" class="section level3"> <div id="description-4" class="section level3">
<h3>Description</h3> <h3>Description</h3>
<p>Generates new consecutive OVID code for the patients that are not found in the DB.</p>
<p>Generates new consecutive OVID or UMID code for the patients that are not found in the DB.</p>
</div> </div>
<div id="usage-4" class="section level3"> <div id="usage-4" class="section level3">
<h3>Usage</h3> <h3>Usage</h3>
<p>sqlGenOVID(conn=dta, nhcs=nhc.test, verb=T, sinc=F)</p>
<p>sqlGenOVID(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL)</p>
</div> </div>
<div id="arguments-4" class="section level3"> <div id="arguments-4" class="section level3">
<h3>Arguments</h3> <h3>Arguments</h3>
@ -457,12 +497,16 @@ sqlShowSamples()
<td>sinc</td> <td>sinc</td>
<td>If TRUE (default is FALSE for security), it adds the new entries to the “OVID” table in the DB.</td> <td>If TRUE (default is FALSE for security), it adds the new entries to the “OVID” table in the DB.</td>
</tr> </tr>
<tr class="odd">
<td>dbtype</td>
<td>used to manually specify the database type. It defaults to NULL and the type is deduced.</td>
</tr>
</tbody> </tbody>
</table> </table>
</div> </div>
<div id="details-4" class="section level3"> <div id="details-4" class="section level3">
<h3>Details</h3> <h3>Details</h3>
<p>Generates new consecutive OVID code for the patients that are not found in the DB.</p>
<p>Generates new consecutive OVID or UMID code for the patients that are not found in the DB.</p>
</div> </div>
<div id="value-4" class="section level3"> <div id="value-4" class="section level3">
<h3>Value</h3> <h3>Value</h3>
@ -476,23 +520,41 @@ sqlGenOVID(sinc=T)
</div> </div>
<div id="function-4" class="section level3"> <div id="function-4" class="section level3">
<h3>Function</h3> <h3>Function</h3>
<pre class="r"><code>sqlGenOVID&lt;-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F){
ovid&lt;-sqlFetch(conn,&quot;OVID&quot;)
<pre class="r"><code>sqlGenOVID&lt;-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL){
if(sqlTables(dta) %&gt;% filter(TABLE_NAME == &quot;UMID&quot;) %&gt;% nrow &gt; 0){dbtype&lt;-&quot;UM&quot;}
if(sqlTables(dta) %&gt;% filter(TABLE_NAME == &quot;OVID&quot;) %&gt;% nrow &gt; 0){dbtype&lt;-&quot;OV&quot;}
if (dbtype == &quot;OV&quot;){
db&lt;-c(&quot;dbcode&quot;=&quot;OVID&quot;)
}
if (dbtype == &quot;UM&quot;){
db&lt;-c(&quot;dbcode&quot;=&quot;UMID&quot;)
}
new.nhc&lt;-nhcs[!nhcs %in% ovid$NHC]
next.num&lt;-gsub(&quot;OVID&quot;,&quot;&quot;,ovid$OVID) %&gt;% as.numeric %&gt;% max(na.rm=T)+1
dbid&lt;-sqlFetch(conn,db[&quot;dbcode&quot;])
new.nhc&lt;-nhcs[!nhcs %in% dbid$NHC]
next.num&lt;-gsub(db[&quot;dbcode&quot;],&quot;&quot;,dbid[,db[&quot;dbcode&quot;]]) %&gt;% as.numeric %&gt;% max(na.rm=T)+1
last.num&lt;-next.num+(length(new.nhc)-1) last.num&lt;-next.num+(length(new.nhc)-1)
upd.ovid&lt;-rbind(ovid,data.frame(&quot;NHC&quot;=new.nhc, &quot;OVID&quot;=sprintf(&quot;OVID%04d&quot;,next.num:last.num)))
rownames(upd.ovid)&lt;-as.character(1:nrow(upd.ovid))
upd.ovid&lt;-filter(upd.ovid, NHC %in% new.nhc) %&gt;% mutate(NHC=as.character(NHC))
newtab&lt;-data.frame(&quot;NHC&quot;=new.nhc, &quot;ID&quot;=sprintf(&quot;%s%04d&quot;,db[&quot;dbcode&quot;],next.num:last.num)) %&gt;% rename(!!db[&quot;dbcode&quot;]:=&quot;ID&quot;)
if(dbtype==&quot;OV&quot;){
dbid&lt;-rbind(dbid,newtab)
}
if(dbtype==&quot;UM&quot;){
dbid&lt;-merge(dbid, newtab, all=T) %&gt;% select(Id,NHC,UMID) %&gt;% arrange(Id)
dbid$Id&lt;-as.numeric(rownames(dbid))
dbid$NHC&lt;-as.numeric(dbid$NHC)
}
rownames(dbid)&lt;-as.character(1:nrow(dbid))
dbid&lt;-filter(dbid, NHC %in% new.nhc) %&gt;% mutate(NHC=as.character(NHC))
if (sinc){ if (sinc){
### !! Atención, esto cambia la base de datos: ### !! Atención, esto cambia la base de datos:
sqlSave(conn, upd.ovid, tablename=&quot;OVID&quot;, append = T)
sqlSave(conn, dbid, tablename=db[&quot;dbcode&quot;], append = T)
print(&quot;La base ha sido actualizada.&quot;) print(&quot;La base ha sido actualizada.&quot;)
} }
if (verb){ if (verb){
return(upd.ovid)
return(dbid)
} }
}</code></pre> }</code></pre>
<hr /> <hr />
@ -502,15 +564,19 @@ sqlGenOVID(sinc=T)
<h2>sqlWriteTemp</h2> <h2>sqlWriteTemp</h2>
<div id="description-5" class="section level3"> <div id="description-5" class="section level3">
<h3>Description</h3> <h3>Description</h3>
<p>Fills the Query Template file with the OVID and OV newly generated codes.</p>
<p>Fills the Query Template file with the OVID or UMID and OV or UM newly generated codes.</p>
</div> </div>
<div id="usage-5" class="section level3"> <div id="usage-5" class="section level3">
<h3>Usage</h3> <h3>Usage</h3>
<p>sqlWriteTemp(conn=dta, nhcs=nhc.test, file=“queryOV.xlsx”, samples.mod=T, clinics.mod=T)</p>
<p>sqlWriteTemp(conn=dta, nhcs=nhc.test, file=“queryOV.xlsx”, samples.mod=T, clinics.mod=T, dbtype=NULL)</p>
</div> </div>
<div id="arguments-5" class="section level3"> <div id="arguments-5" class="section level3">
<h3>Arguments</h3> <h3>Arguments</h3>
<table> <table>
<colgroup>
<col width="50%" />
<col width="50%" />
</colgroup>
<thead> <thead>
<tr class="header"> <tr class="header">
<th>Argument</th> <th>Argument</th>
@ -538,12 +604,16 @@ sqlGenOVID(sinc=T)
<td>clinics.mod</td> <td>clinics.mod</td>
<td>If TRUE (default), it fills the “CLINICS” template sheet.</td> <td>If TRUE (default), it fills the “CLINICS” template sheet.</td>
</tr> </tr>
<tr class="even">
<td>dbtype</td>
<td>used to manually specify the database type. It defaults to NULL and the type is deduced.</td>
</tr>
</tbody> </tbody>
</table> </table>
</div> </div>
<div id="details-5" class="section level3"> <div id="details-5" class="section level3">
<h3>Details</h3> <h3>Details</h3>
<p>Fills the Query Template file with the OVID and OV newly generated codes. It is required that the DB has been updated with the sqlGenOVID function. It replaces previous content in the template file sheets that are filled. In the case of “CLINICS” table, if there were already an entry in the DB for that OVID code, the template file is filled with that information.</p>
<p>Fills the Query Template file with the OVID and OV or UMID and UM newly generated codes. It is required that the DB has been updated with the sqlGenOVID function. It replaces previous content in the template file sheets that are filled. In the case of “CLINICS” table, if there were already an entry in the DB for that OVID/UMID code, the template file is filled with that information.</p>
</div> </div>
<div id="value-5" class="section level3"> <div id="value-5" class="section level3">
<h3>Value</h3> <h3>Value</h3>
@ -558,37 +628,74 @@ sqlWriteTemp()
</div> </div>
<div id="function-5" class="section level3"> <div id="function-5" class="section level3">
<h3>Function</h3> <h3>Function</h3>
<pre class="r"><code>sqlWriteTemp&lt;-function(conn=dta, nhcs=nhc.test, file=&quot;queryOV.xlsx&quot;, samples.mod=T, clinics.mod=T){
upd.ovid&lt;-sqlFetch(conn, &quot;OVID&quot;) %&gt;% filter(NHC %in% nhcs)
if (samples.mod){
## Generar código para las nuevas muestras
samples&lt;-sqlFetch(conn, &quot;SAMPLES&quot;)
if(sum(grepl(paste0(&quot;OV&quot;,Sys.time() %&gt;% format(&quot;%y&quot;)), samples$samples)) &gt; 0){
next.samp&lt;-gsub(paste0(&quot;OV&quot;,Sys.time() %&gt;% format(&quot;%y&quot;)),&quot;&quot;, samples$samples) %&gt;% as.numeric %&gt;% max(na.rm=T)+1
}else{
next.samp&lt;-1
<pre class="r"><code>sqlWriteTemp&lt;-function(conn=dta, nhcs=nhc.test, file=&quot;queryOV.xlsx&quot;, samples.mod=T, clinics.mod=T, dbtype=NULL){
if(sqlTables(dta) %&gt;% filter(TABLE_NAME == &quot;UMID&quot;) %&gt;% nrow &gt; 0){dbtype&lt;-&quot;UM&quot;}
if(sqlTables(dta) %&gt;% filter(TABLE_NAME == &quot;OVID&quot;) %&gt;% nrow &gt; 0){dbtype&lt;-&quot;OV&quot;}
if (dbtype==&quot;OV&quot;){
upd.ovid&lt;-sqlFetch(conn, &quot;OVID&quot;) %&gt;% filter(NHC %in% nhcs)
if (samples.mod){
## Generar código para las nuevas muestras
samples&lt;-sqlFetch(conn, &quot;SAMPLES&quot;)
if(sum(grepl(paste0(&quot;OV&quot;,Sys.time() %&gt;% format(&quot;%y&quot;)), samples$samples)) &gt; 0){
next.samp&lt;-gsub(paste0(&quot;OV&quot;,Sys.time() %&gt;% format(&quot;%y&quot;)),&quot;&quot;, samples$samples) %&gt;% as.numeric %&gt;% max(na.rm=T)+1
}else{
next.samp&lt;-1
}
last.samp&lt;-next.samp+(length(nhcs)-1)
new.samp&lt;-sprintf(&quot;OV%s%02d&quot;,Sys.time() %&gt;% format(&quot;%y&quot;),next.samp:last.samp)
new.samp.df&lt;-merge(sqlFetch(dta,&quot;OVID&quot;) %&gt;% merge(data.frame(&quot;NHC&quot;=nhcs)), data.frame(&quot;NHC&quot;=nhcs, &quot;samples&quot;=new.samp))
samples.exp&lt;-merge(samples %&gt;% slice(0), new.samp.df %&gt;% select(-NHC), all=T) %&gt;% select(colnames(samples)) %&gt;% arrange(samples)
}
if (clinics.mod){
## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
upd.clinics&lt;-sqlFetch(conn, &quot;CLINICS&quot;)
ovid.new&lt;-sqlFetch(conn, &quot;OVID&quot;) %&gt;% filter(NHC %in% nhcs)
upd.clinics&lt;-merge(ovid.new,upd.clinics, all.x=T, by=&quot;OVID&quot;)
upd.clinics$NHC&lt;-as.character(upd.clinics$NHC)
for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]&lt;-as.Date(upd.clinics[,i])}
} }
last.samp&lt;-next.samp+(length(nhcs)-1)
new.samp&lt;-sprintf(&quot;OV%s%02d&quot;,Sys.time() %&gt;% format(&quot;%y&quot;),next.samp:last.samp)
new.samp.df&lt;-merge(sqlFetch(dta,&quot;OVID&quot;) %&gt;% merge(data.frame(&quot;NHC&quot;=nhcs)), data.frame(&quot;NHC&quot;=nhcs, &quot;samples&quot;=new.samp))
samples.exp&lt;-merge(samples %&gt;% slice(0), new.samp.df %&gt;% select(-NHC), all=T) %&gt;% select(colnames(samples)) %&gt;% arrange(samples)
}
if (clinics.mod){
## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
upd.clinics&lt;-sqlFetch(conn, &quot;CLINICS&quot;)
ovid.new&lt;-sqlFetch(conn, &quot;OVID&quot;) %&gt;% filter(NHC %in% nhcs)
upd.clinics&lt;-merge(ovid.new,upd.clinics, all.x=T, by=&quot;OVID&quot;)
upd.clinics$NHC&lt;-as.character(upd.clinics$NHC)
for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]&lt;-as.Date(upd.clinics[,i])}
## Exportar tablas a la plantilla de entrada para su rellenado
wb &lt;- loadWorkbook(file)
writeData(wb, &quot;NHC&quot;, upd.ovid)
if (samples.mod){writeData(wb,&quot;samples&quot;,samples.exp)}
if (clinics.mod){writeData(wb,&quot;CLINICS&quot;,upd.clinics)}
saveWorkbook(wb,file,overwrite = TRUE)
}
if (dbtype==&quot;UM&quot;){
upd.umid&lt;-sqlFetch(conn, &quot;UMID&quot;) %&gt;% filter(NHC %in% nhcs)
if (samples.mod){
## Generar código para las nuevas muestras
samples&lt;-sqlFetch(conn, &quot;MUESTRAS&quot;)
if(sum(grepl(paste0(&quot;UM&quot;,Sys.time() %&gt;% format(&quot;%y&quot;)), samples$CODIGO)) &gt; 0){
next.samp&lt;-gsub(paste0(&quot;UM&quot;,Sys.time() %&gt;% format(&quot;%y&quot;)),&quot;&quot;, samples$CODIGO) %&gt;% as.numeric %&gt;% max(na.rm=T)+1
}else{
next.samp&lt;-1
}
last.samp&lt;-next.samp+(length(nhcs)-1)
new.samp&lt;-sprintf(&quot;UM%s%02d&quot;,Sys.time() %&gt;% format(&quot;%y&quot;),next.samp:last.samp)
new.samp.df&lt;-merge(sqlFetch(dta,&quot;UMID&quot;) %&gt;% merge(data.frame(&quot;NHC&quot;=nhcs)), data.frame(&quot;NHC&quot;=nhcs, &quot;CODIGO&quot;=new.samp))
samples.exp&lt;-merge(samples %&gt;% slice(0), new.samp.df %&gt;% select(-NHC), all=T) %&gt;% select(colnames(samples)) %&gt;% arrange(CODIGO)
}
if (clinics.mod){
## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
upd.clinics&lt;-sqlFetch(conn, &quot;CLINICOS&quot;)
umid.new&lt;-sqlFetch(conn, &quot;UMID&quot;) %&gt;% filter(NHC %in% nhcs)
upd.clinics&lt;-merge(umid.new,upd.clinics %&gt;% select(-Id), all.x=T, by=&quot;UMID&quot;)
upd.clinics$NHC&lt;-as.character(upd.clinics$NHC)
for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]&lt;-as.Date(upd.clinics[,i])}
}
## Exportar tablas a la plantilla de entrada para su rellenado
wb &lt;- loadWorkbook(file)
writeData(wb, &quot;NHC&quot;, upd.umid)
if (samples.mod){writeData(wb,&quot;samples&quot;,samples.exp)}
if (clinics.mod){writeData(wb,&quot;CLINICS&quot;,upd.clinics)}
saveWorkbook(wb,file,overwrite = TRUE)
} }
## Exportar tablas a la plantilla de entrada para su rellenado
wb &lt;- loadWorkbook(file)
writeData(wb, &quot;NHC&quot;, upd.ovid)
if (samples.mod){writeData(wb,&quot;samples&quot;,samples.exp)}
if (clinics.mod){writeData(wb,&quot;CLINICS&quot;,upd.clinics)}
saveWorkbook(wb,file,overwrite = TRUE)
}</code></pre> }</code></pre>
<hr /> <hr />
</div> </div>
@ -601,7 +708,7 @@ sqlWriteTemp()
</div> </div>
<div id="usage-6" class="section level3"> <div id="usage-6" class="section level3">
<h3>Usage</h3> <h3>Usage</h3>
<p>sqlSincBD(conn=dta, filetemp=“QueryOV.xlsx”, sinc.samples=F, sinc.clinics=F)</p>
<p>sqlSincBD(conn=dta, filetemp=“queryOV.xlsx”, sinc.samples=F, sinc.clinics=F, dbtype=NULL)</p>
</div> </div>
<div id="arguments-6" class="section level3"> <div id="arguments-6" class="section level3">
<h3>Arguments</h3> <h3>Arguments</h3>
@ -633,6 +740,10 @@ sqlWriteTemp()
<td>clinics.mod</td> <td>clinics.mod</td>
<td>If TRUE (default is FALSE for security), it updates the CLINICS table in the DB with the information in the “CLINICS” template sheet.</td> <td>If TRUE (default is FALSE for security), it updates the CLINICS table in the DB with the information in the “CLINICS” template sheet.</td>
</tr> </tr>
<tr class="odd">
<td>dbtype</td>
<td>used to manually specify the database type. It defaults to NULL and the type is deduced.</td>
</tr>
</tbody> </tbody>
</table> </table>
</div> </div>
@ -654,53 +765,193 @@ sqlSincBD(sinc.samples=T, sinc.clinics=T)
</div> </div>
<div id="function-6" class="section level3"> <div id="function-6" class="section level3">
<h3>Function</h3> <h3>Function</h3>
<pre class="r"><code>sqlSincBD&lt;-function(conn=dta, filetemp=&quot;QueryOV.xlsx&quot;, sinc.samples=F, sinc.clinics=F){
## Añadir código de muestra nueva a la base de datos
nsamples&lt;-sqlFetch(conn, &quot;SAMPLES&quot;) %&gt;% nrow
upd.samples&lt;-read.xlsx(filetemp, sheet = &quot;samples&quot;, detectDates = T)
if (nrow(upd.samples) &gt; 0){rownames(upd.samples)&lt;-(nsamples+1):(nsamples+nrow(upd.samples)) %&gt;% as.character}
<pre class="r"><code>sqlSincBD&lt;-function(conn=dta, filetemp=&quot;queryOV.xlsx&quot;, sinc.samples=F, sinc.clinics=F, dbtype=NULL){
if(sqlTables(dta) %&gt;% filter(TABLE_NAME == &quot;UMID&quot;) %&gt;% nrow &gt; 0){dbtype&lt;-&quot;UM&quot;}
if(sqlTables(dta) %&gt;% filter(TABLE_NAME == &quot;OVID&quot;) %&gt;% nrow &gt; 0){dbtype&lt;-&quot;OV&quot;}
if (sinc.samples &amp; nrow(upd.samples) &gt; 0){
upd.samples$IQ_date&lt;-as.Date(upd.samples$IQ_date)
### !! Atención, esto cambia la base de datos:
sqlSave(conn, upd.samples, tablename=&quot;SAMPLES&quot;, append = T, varTypes = c(&quot;IQ_date&quot;=&quot;date&quot;))
print(&quot;Tabla SAMPLES sincronizada.&quot;)
## Añadir código de muestra nueva a la base de datos
if (dbtype == &quot;OV&quot;){
print(&quot;DB OV detectada&quot;)
nsamples&lt;-sqlFetch(conn, &quot;SAMPLES&quot;) %&gt;% nrow
upd.samples&lt;-read.xlsx(filetemp, sheet = &quot;samples&quot;, detectDates = T)
if (nrow(upd.samples) &gt; 0){rownames(upd.samples)&lt;-(nsamples+1):(nsamples+nrow(upd.samples)) %&gt;% as.character}
if (sinc.samples &amp; nrow(upd.samples) &gt; 0){
upd.samples$IQ_date&lt;-as.Date(upd.samples$IQ_date)
upd.samples$TIL_date&lt;-as.Date(upd.samples$TIL_date)
### !! Atención, esto cambia la base de datos:
sqlSave(conn, upd.samples, tablename=&quot;SAMPLES&quot;, append = T, varTypes = c(&quot;IQ_date&quot;=&quot;date&quot;,&quot;TIL_date&quot;=&quot;date&quot;))
print(&quot;Tabla SAMPLES sincronizada.&quot;)
}
}
if (dbtype == &quot;UM&quot;){
print(&quot;DB UM detectada&quot;)
nsamples&lt;-sqlFetch(conn, &quot;MUESTRAS&quot;) %&gt;% nrow
upd.samples&lt;-read.xlsx(filetemp, sheet = &quot;samples&quot;, detectDates = T)
if (nrow(upd.samples) &gt; 0){rownames(upd.samples)&lt;-(nsamples+1):(nsamples+nrow(upd.samples)) %&gt;% as.character}
if (sinc.samples &amp; nrow(upd.samples) &gt; 0){
upd.samples$FECHA_RECEPCION&lt;-as.Date(upd.samples$FECHA_RECEPCION)
upd.samples$TIPO&lt;-as.character(upd.samples$TIPO)
upd.samples$OBS&lt;-as.character(upd.samples$OBS)
### !! Atención, esto cambia la base de datos:
sqlSave(conn, upd.samples, tablename=&quot;MUESTRAS&quot;, append = T, varTypes = c(&quot;FECHA_RECEPCION&quot;=&quot;Date&quot;), rownames = F)
print(&quot;Tabla MUESTRAS sincronizada.&quot;)
}
} }
## Añadir datos clínicos modificados a la base de datos ## Añadir datos clínicos modificados a la base de datos
upd.clinics&lt;-read.xlsx(filetemp, sheet = &quot;CLINICS&quot;,detectDates = T)
ovid.mod&lt;-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, &quot;CLINICS&quot;) %&gt;% pull(OVID))]
rnames&lt;-sqlFetch(conn, &quot;CLINICS&quot;) %&gt;% filter(OVID %in% ovid.mod) %&gt;% rownames
clinics.mod&lt;-upd.clinics %&gt;% filter(OVID %in% ovid.mod) %&gt;% select(-NHC)
rownames(clinics.mod)&lt;-rnames
### !! Atención, esto cambia la base de datos:
if (sinc.clinics){
fechas&lt;-colnames(clinics.mod)[grepl(&quot;DO|date&quot;, colnames(clinics.mod))]
for (i in fechas){
clinics.mod[,i]&lt;-as.Date(clinics.mod[,i])
if (dbtype == &quot;OV&quot;){
upd.clinics&lt;-read.xlsx(filetemp, sheet = &quot;CLINICS&quot;,detectDates = T)
ovid.mod&lt;-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, &quot;CLINICS&quot;) %&gt;% pull(OVID))]
rnames&lt;-sqlFetch(conn, &quot;CLINICS&quot;) %&gt;% filter(OVID %in% ovid.mod) %&gt;% rownames
clinics.mod&lt;-upd.clinics %&gt;% filter(OVID %in% ovid.mod) %&gt;% select(-NHC)
rownames(clinics.mod)&lt;-rnames
### !! Atención, esto cambia la base de datos:
if (sinc.clinics){
fechas&lt;-colnames(clinics.mod)[grepl(&quot;DO|date&quot;, colnames(clinics.mod))]
for (i in fechas){
clinics.mod[,i]&lt;-as.Date(clinics.mod[,i])
}
sqlUpdate(conn, clinics.mod,&quot;CLINICS&quot;)
print(&quot;Tabla CLINICS modificada.&quot;)
}
}
if (dbtype == &quot;UM&quot;){
upd.clinics&lt;-read.xlsx(filetemp, sheet = &quot;CLINICS&quot;,detectDates = T)
umid.mod&lt;-upd.clinics$UMID[upd.clinics$UMID %in% (sqlFetch(dta, &quot;CLINICOS&quot;) %&gt;% pull(UMID))]
rnames&lt;-sqlFetch(conn, &quot;CLINICOS&quot;) %&gt;% filter(UMID %in% umid.mod) %&gt;% rownames
clinics.mod&lt;-upd.clinics %&gt;% filter(UMID %in% umid.mod) %&gt;% select(-NHC)
rownames(clinics.mod)&lt;-rnames
### !! Atención, esto cambia la base de datos:
if (sinc.clinics){
fechas&lt;-colnames(clinics.mod)[grepl(&quot;date|MET_DX|DoB&quot;, colnames(clinics.mod), ignore.case = T)]
for (i in fechas){
clinics.mod[,i]&lt;-as.Date(clinics.mod[,i])
}
sqlUpdate(conn, clinics.mod,&quot;CLINICOS&quot;)
print(&quot;Tabla CLINICOS modificada.&quot;)
} }
sqlUpdate(conn, clinics.mod,&quot;CLINICS&quot;)
print(&quot;Tabla CLINICS modificada.&quot;)
} }
## Añadir datos clínicos nuevos a la base de datos ## Añadir datos clínicos nuevos a la base de datos
nsamples.clin&lt;-sqlFetch(conn, &quot;CLINICS&quot;) %&gt;% nrow
ovid.new&lt;-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(conn, &quot;CLINICS&quot;) %&gt;% pull(OVID))]
clinics.new&lt;-upd.clinics %&gt;% filter(OVID %in% ovid.new) %&gt;% select(-NHC)
if (length(ovid.new) &gt; 0){rownames(clinics.new)&lt;-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %&gt;% as.character}
### !! Atención, esto cambia la base de datos:
if (sinc.clinics){
fechas&lt;-colnames(clinics.new)[grepl(&quot;DO|date&quot;, colnames(clinics.new))]
varTypes&lt;-rep(&quot;Date&quot;,length(fechas))
names(varTypes)&lt;-fechas
for (i in fechas){
clinics.new[,i]&lt;-as.Date(clinics.new[,i])
if (dbtype == &quot;OV&quot;){
nsamples.clin&lt;-sqlFetch(conn, &quot;CLINICS&quot;) %&gt;% nrow
ovid.new&lt;-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(conn, &quot;CLINICS&quot;) %&gt;% pull(OVID))]
clinics.new&lt;-upd.clinics %&gt;% filter(OVID %in% ovid.new) %&gt;% select(-NHC)
if (length(ovid.new) &gt; 0){rownames(clinics.new)&lt;-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %&gt;% as.character}
### !! Atención, esto cambia la base de datos:
if (sinc.clinics){
fechas&lt;-colnames(clinics.new)[grepl(&quot;DO|date&quot;, colnames(clinics.new))]
varTypes&lt;-rep(&quot;Date&quot;,length(fechas))
names(varTypes)&lt;-fechas
for (i in fechas){
clinics.new[,i]&lt;-as.Date(clinics.new[,i])
}
sqlSave(conn, clinics.new, tablename=&quot;CLINICS&quot;, append = T, varTypes = varTypes)
print(&quot;Tabla CLINICS sincronizada.&quot;)
} }
sqlSave(conn, clinics.new, tablename=&quot;CLINICS&quot;, append = T, varTypes = varTypes)
print(&quot;Tabla CLINICS sincronizada.&quot;)
} }
if (dbtype == &quot;UM&quot;){
nsamples.clin&lt;-sqlFetch(conn, &quot;CLINICOS&quot;) %&gt;% nrow
umid.new&lt;-upd.clinics$UMID[!upd.clinics$UMID %in% (sqlFetch(conn, &quot;CLINICOS&quot;) %&gt;% pull(UMID))]
clinics.new&lt;-upd.clinics %&gt;% filter(UMID %in% umid.new) %&gt;% select(-NHC)
if (length(umid.new) &gt; 0){rownames(clinics.new)&lt;-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %&gt;% as.character}
### !! Atención, esto cambia la base de datos:
if (sinc.clinics){
fechas&lt;-colnames(clinics.new)[grepl(&quot;date|MET_DX|DoB&quot;, colnames(clinics.new), ignore.case = T)]
varTypes&lt;-rep(&quot;Date&quot;,length(fechas))
names(varTypes)&lt;-fechas
for (i in fechas){
clinics.new[,i]&lt;-as.Date(clinics.new[,i])
}
sqlSave(conn, clinics.new, tablename=&quot;CLINICOS&quot;, append = T, varTypes = varTypes)
print(&quot;Tabla CLINICOS sincronizada.&quot;)
}
}
}</code></pre>
<hr />
</div>
</div>
<div id="sqlmultisamples" class="section level2">
<h2>sqlMultiSamples</h2>
<div id="description-7" class="section level3">
<h3>Description</h3>
<p>Prints a table compiling information about laboratory samples, scRNAseq samples and RNA/DNA samples.</p>
</div>
<div id="usage-7" class="section level3">
<h3>Usage</h3>
<p>sqlMultiSamples(kbl=F, NHC=F, full=F)</p>
</div>
<div id="arguments-7" class="section level3">
<h3>Arguments</h3>
<table>
<colgroup>
<col width="50%" />
<col width="50%" />
</colgroup>
<thead>
<tr class="header">
<th>Argument</th>
<th>Description</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td>kbl</td>
<td>formats the output table with the kableEstra style. Defaults to F.</td>
</tr>
<tr class="even">
<td>NHC</td>
<td>adds the NHC to the table in addition to the UMID. Defaults to F.</td>
</tr>
<tr class="odd">
<td>full</td>
<td>prints also the patients that doesn’t appear in the MUESTRAS table. Defaults to F.</td>
</tr>
</tbody>
</table>
</div>
<div id="details-7" class="section level3">
<h3>Details</h3>
<p>Prints a table compiling information about laboratory samples, scRNAseq samples and RNA/DNA samples.</p>
</div>
<div id="value-7" class="section level3">
<h3>Value</h3>
<p>A data.frame or a kableExtra table.</p>
</div>
<div id="examples-7" class="section level3">
<h3>Examples</h3>
<pre class="r"><code>dta&lt;-odbcConnect(&quot;test&quot;)
sqlMultiSamples()</code></pre>
</div>
<div id="function-7" class="section level3">
<h3>Function</h3>
<pre class="r"><code>sqlMultiSamples&lt;-function(kbl=F, NHC=F, full=F){
query&lt;-sqlQuery(dta, &quot;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&quot;) %&gt;% rename(&quot;CNAG&quot;=&quot;CODIGO.1&quot;,&quot;RNADNA&quot;=&quot;CODIGO.2&quot;)
if (full==F){query&lt;- query %&gt;% filter(!is.na(CODIGO))}
if (NHC==F){query&lt;- query %&gt;% select(-NHC)}
query&lt;-query %&gt;% mutate(
CNAG=case_when(!is.na(CNAG)~&quot;X&quot;,TRUE~&quot;&quot;),
RNADNA=case_when((!is.na(RNADNA) &amp; (ESTADO==&quot;ENV&quot;))~&quot;X&quot;,
(!is.na(RNADNA) &amp; (is.na(ESTADO)))~&quot;.&quot;,
TRUE~&quot;&quot;)
) %&gt;% select(-ESTADO)
if (kbl==T){
query %&gt;% kableExtra::kbl() %&gt;% kableExtra::kable_styling(full_width = F, bootstrap_options = c(&quot;striped&quot;))
}else{
return(query)
}
}</code></pre> }</code></pre>
</div> </div>
</div> </div>

+ 255
- 94
sqlFunctions.R

@ -1,9 +1,16 @@
require(RODBC) require(RODBC)
sqlDropLast<-function(conn, tablename, droplast=1){
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<-sqlFetch(conn, tablename)
table<-table[1:(nrow(table)-droplast),] 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(){ sqlInitialize<-function(){
@ -15,7 +22,10 @@ sqlInitialize<-function(){
source("ruta_database.R", encoding = "UTF-8") 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) db=strsplit(dbfile, "/")[[1]]%>% tail(n=1)
bu_path<-gsub(db,bu.dir,dbfile) bu_path<-gsub(db,bu.dir,dbfile)
if (!dir.exists(bu_path)){ if (!dir.exists(bu_path)){
@ -26,120 +36,271 @@ sqlBackUp<-function(dbfile=file,bu.dir){
file.copy(dbfile, cp_bu) file.copy(dbfile, cp_bu)
} }
sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F){
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)){ 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)
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)
}else{ }else{
sqlQuery(conn, "SELECT O.NHC,S.*
FROM SAMPLES S
INNER JOIN OVID O
ON O.OVID=S.OVID") %>% filter(NHC %in% nhcs)
sqlQuery(conn, query) %>% 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))
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 (sinc){
### !! Atención, esto cambia la base de datos:
sqlSave(conn, upd.ovid, tablename="OVID", append = T)
print("La base ha sido actualizada.")
if (dbtype == "OV"){
db<-c("dbcode"="OVID")
} }
if (verb){
return(upd.ovid)
if (dbtype == "UM"){
db<-c("dbcode"="UMID")
}
dbid<-sqlFetch(conn,db["dbcode"])
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
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(Id,NHC,UMID) %>% arrange(Id)
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)
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){
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 ## 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 ## 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, 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)
}
}

+ 4
- 4
workflow.R

@ -1,4 +1,4 @@
source("sqlFunctions.R")
source("sqlFunctions.R", encoding = "UTF-8")
# Cargar dependencias # Cargar dependencias
sqlInitialize() sqlInitialize()
@ -6,13 +6,13 @@ sqlInitialize()
## Asegurarse de que la variable file sea la que nos corresponde: ## Asegurarse de que la variable file sea la que nos corresponde:
file file
# Crear copia de seguridad
sqlBackUp()
# Inicializar conexión # Inicializar conexión
dta<-odbcConnectAccess2007(access.file = file, dta<-odbcConnectAccess2007(access.file = file,
pwd = .rs.askForPassword("Enter password:")) pwd = .rs.askForPassword("Enter password:"))
# Crear copia de seguridad
sqlBackUp()
## Importamos los NHC de las muestras nuevas ## Importamos los NHC de las muestras nuevas
nhc.test<-read.xlsx("queryOV.xlsx", sheet = "NHC") %>% pull(NHC) nhc.test<-read.xlsx("queryOV.xlsx", sheet = "NHC") %>% pull(NHC)

Loading…
Cancel
Save