BDAccess/sqlFunctions.R

require(RODBC)

sqlDropLast<-function(conn, tablename, droplast=1){
  table<-sqlFetch(conn, tablename)
  table<-table[1:(nrow(table)-droplast),]
  sqlSave(conn, table, tablename = tablename, safer = F)
}

sqlInitialize<-function(){
  library(tidyverse)
  library(RODBC)
  library(openxlsx)
  
  ## Conexión a la base de datos
  source("ruta_database.R", encoding = "UTF-8")
}

sqlBackUp<-function(dbfile=file,bu.dir){
  db=strsplit(dbfile, "/")[[1]]%>% tail(n=1)
  bu_path<-gsub(db,bu.dir,dbfile)
  if (!dir.exists(bu_path)){
    dir.create(bu_path)
    print(paste0("Back Up directory ", bu_path, " created"))
  }
  cp_bu<-paste0(bu_path, "/", format(Sys.time(), format="%Y%m%d"),"-",db)
  file.copy(dbfile, cp_bu)
}

sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F, dbtype){
  if (dbtype == "OV"){
    db<-c("dbtables"="SAMPLES", "dbcode"="OVID", "dbsamples"="samples")
    query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"])
  }
  if (dbtype == "UM"){
    db<-c("dbtables"="MUESTRAS", "dbcode"="UMID", "dbsamples"="CODIGO")
    query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"])
  }
  if (nrow(sqlQuery(conn, query) %>% filter(NHC %in% nhcs)) == 0){
    return("No hay muestras de ningún paciente.")
  }
  if (isFALSE(verb)){
    sqlQuery(conn, query) %>% filter(NHC %in% nhcs) %>% 
    group_by(NHC,UQ(rlang::sym(db["dbcode"]))) %>% summarise(Samples=length(UQ(rlang::sym(db["dbsamples"]))), Names=paste0(UQ(rlang::sym(db["dbsamples"])), collapse = ";")) %>% 
      merge(data.frame(NHC=nhcs),all=T) %>% mutate(NHC=factor(NHC,levels = nhcs)) %>% arrange(NHC)
  }else{
    sqlQuery(conn, query) %>% filter(NHC %in% nhcs)
  }
}

sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype){
  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)
  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<-rownames(dbid)
  }
  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)
  }
}

sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T){
  upd.ovid<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs)
  if (samples.mod){
    ## Generar código para las nuevas muestras
    samples<-sqlFetch(conn, "SAMPLES")
    if(sum(grepl(paste0("OV",Sys.time() %>% format("%y")), samples$samples)) > 0){
      next.samp<-gsub(paste0("OV",Sys.time() %>% format("%y")),"", samples$samples) %>% as.numeric %>% max(na.rm=T)+1  
    }else{
      next.samp<-1
    }
    last.samp<-next.samp+(length(nhcs)-1)
    new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp)
    new.samp.df<-merge(sqlFetch(dta,"OVID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "samples"=new.samp))
    samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples)
  }
  
  if (clinics.mod){
    ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
    upd.clinics<-sqlFetch(conn, "CLINICS")
    ovid.new<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs)
    upd.clinics<-merge(ovid.new,upd.clinics, all.x=T, by="OVID")
    upd.clinics$NHC<-as.character(upd.clinics$NHC)
    for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])}
  }

  ## Exportar tablas a la plantilla de entrada para su rellenado
  wb <- loadWorkbook(file)
  writeData(wb, "NHC", upd.ovid)
  if (samples.mod){writeData(wb,"samples",samples.exp)}
  if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)}
  saveWorkbook(wb,file,overwrite = TRUE)
}

sqlSincBD<-function(conn=dta, filetemp="QueryOV.xlsx", sinc.samples=F, sinc.clinics=F){
  ## Añadir código de muestra nueva a la base de datos
  nsamples<-sqlFetch(conn, "SAMPLES") %>% nrow
  upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T)
  if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character}
  
  if (sinc.samples & nrow(upd.samples) > 0){
    upd.samples$IQ_date<-as.Date(upd.samples$IQ_date)
    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 datos clínicos modificados a la base de datos
  upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T)
  ovid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))]
  rnames<-sqlFetch(conn, "CLINICS") %>% filter(OVID %in% ovid.mod) %>% rownames
  clinics.mod<-upd.clinics %>% filter(OVID %in% ovid.mod) %>% select(-NHC)
  rownames(clinics.mod)<-rnames
  
  ### !! Atención, esto cambia la base de datos:
  if (sinc.clinics){
    fechas<-colnames(clinics.mod)[grepl("DO|date", colnames(clinics.mod))]
    for (i in fechas){
      clinics.mod[,i]<-as.Date(clinics.mod[,i])
    }
    sqlUpdate(conn, clinics.mod,"CLINICS")
    print("Tabla CLINICS modificada.")
  }
  
  ## Añadir datos clínicos nuevos a la base de datos
  nsamples.clin<-sqlFetch(conn, "CLINICS") %>% nrow
  ovid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(conn, "CLINICS") %>% pull(OVID))]
  clinics.new<-upd.clinics %>% filter(OVID %in% ovid.new) %>% select(-NHC)
  if (length(ovid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character}
  
  ### !! Atención, esto cambia la base de datos:
  if (sinc.clinics){
    fechas<-colnames(clinics.new)[grepl("DO|date", colnames(clinics.new))]
    varTypes<-rep("Date",length(fechas))
    names(varTypes)<-fechas
    for (i in fechas){
      clinics.new[,i]<-as.Date(clinics.new[,i])
    }
    sqlSave(conn, clinics.new, tablename="CLINICS", append = T, varTypes = varTypes)
    print("Tabla CLINICS sincronizada.")
  }
}

sqlMultiSamples<-function(kbl=F, NHC=F){
  query<-sqlQuery(dta, "SELECT M.UMID,U.NHC,M.FECHA_RECEPCION,M.CODIGO,C.CODIGO,R.CODIGO 
         FROM ((MUESTRAS M
         LEFT OUTER JOIN CNAG C ON M.CODIGO=C.CODIGO)
         LEFT OUTER JOIN RNADNA R ON M.CODIGO=R.CODIGO)
         LEFT OUTER JOIN UMID U ON U.UMID=M.UMID") %>% rename("CNAG"="CODIGO.1","RNADNA"="CODIGO.2")
  
  query<-query %>% mutate(
    CNAG=case_when(!is.na(CNAG)~"X",TRUE~""),
    RNADNA=case_when(!is.na(RNADNA)~"X",TRUE~"")
  )
  if (kbl==T){
    query %>% kableExtra::kbl() %>% kableExtra::kable_styling(full_width = F, bootstrap_options = c("striped"))
  }else{
    return(query)
    }
}