Scripts relacionados con el acceso y análisis en bases de datos Access.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

151 lines
6.3 KiB

  1. require(RODBC)
  2. sqlDropLast<-function(conn, tablename, droplast=1){
  3. table<-sqlFetch(conn, tablename)
  4. table<-table[1:(nrow(table)-droplast),]
  5. sqlSave(conn, table, tablename = tablename, safer = F)
  6. }
  7. sqlInitialize<-function(){
  8. library(tidyverse)
  9. library(RODBC)
  10. library(openxlsx)
  11. ## Conexión a la base de datos
  12. source("ruta_database.R", encoding = "UTF-8")
  13. }
  14. sqlBackUp<-function(dbfile=file,bu.dir){
  15. db=strsplit(dbfile, "/")[[1]]%>% tail(n=1)
  16. bu_path<-gsub(db,bu.dir,dbfile)
  17. if (!dir.exists(bu_path)){
  18. dir.create(bu_path)
  19. print(paste0("Back Up directory ", bu_path, " created"))
  20. }
  21. cp_bu<-paste0(bu_path, "/", format(Sys.time(), format="%Y%m%d"),"-",db)
  22. file.copy(dbfile, cp_bu)
  23. }
  24. sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F, dbtype){
  25. if (dbtype == "OV"){
  26. db<-c("dbtables"="SAMPLES", "dbcode"="OVID", "dbsamples"="samples")
  27. query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"])
  28. }
  29. if (dbtype == "UM"){
  30. db<-c("dbtables"="MUESTRAS", "dbcode"="UMID", "dbsamples"="CODIGO")
  31. query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"])
  32. }
  33. if (nrow(sqlQuery(conn, query) %>% filter(NHC %in% nhcs)) == 0){
  34. return("No hay muestras de ningún paciente.")
  35. }
  36. if (isFALSE(verb)){
  37. sqlQuery(conn, query) %>% filter(NHC %in% nhcs) %>%
  38. group_by(NHC,UQ(rlang::sym(db["dbcode"]))) %>% summarise(Samples=length(UQ(rlang::sym(db["dbsamples"]))), Names=paste0(UQ(rlang::sym(db["dbsamples"])), collapse = ";")) %>%
  39. merge(data.frame(NHC=nhcs),all=T) %>% mutate(NHC=factor(NHC,levels = nhcs)) %>% arrange(NHC)
  40. }else{
  41. sqlQuery(conn, query) %>% filter(NHC %in% nhcs)
  42. }
  43. }
  44. sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F){
  45. ovid<-sqlFetch(conn,"OVID")
  46. new.nhc<-nhcs[!nhcs %in% ovid$NHC]
  47. next.num<-gsub("OVID","",ovid$OVID) %>% as.numeric %>% max(na.rm=T)+1
  48. last.num<-next.num+(length(new.nhc)-1)
  49. upd.ovid<-rbind(ovid,data.frame("NHC"=new.nhc, "OVID"=sprintf("OVID%04d",next.num:last.num)))
  50. rownames(upd.ovid)<-as.character(1:nrow(upd.ovid))
  51. upd.ovid<-filter(upd.ovid, NHC %in% new.nhc) %>% mutate(NHC=as.character(NHC))
  52. if (sinc){
  53. ### !! Atención, esto cambia la base de datos:
  54. sqlSave(conn, upd.ovid, tablename="OVID", append = T)
  55. print("La base ha sido actualizada.")
  56. }
  57. if (verb){
  58. return(upd.ovid)
  59. }
  60. }
  61. sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T){
  62. upd.ovid<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs)
  63. if (samples.mod){
  64. ## Generar código para las nuevas muestras
  65. samples<-sqlFetch(conn, "SAMPLES")
  66. if(sum(grepl(paste0("OV",Sys.time() %>% format("%y")), samples$samples)) > 0){
  67. next.samp<-gsub(paste0("OV",Sys.time() %>% format("%y")),"", samples$samples) %>% as.numeric %>% max(na.rm=T)+1
  68. }else{
  69. next.samp<-1
  70. }
  71. last.samp<-next.samp+(length(nhcs)-1)
  72. new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp)
  73. new.samp.df<-merge(sqlFetch(dta,"OVID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "samples"=new.samp))
  74. samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples)
  75. }
  76. if (clinics.mod){
  77. ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
  78. upd.clinics<-sqlFetch(conn, "CLINICS")
  79. ovid.new<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs)
  80. upd.clinics<-merge(ovid.new,upd.clinics, all.x=T, by="OVID")
  81. upd.clinics$NHC<-as.character(upd.clinics$NHC)
  82. for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])}
  83. }
  84. ## Exportar tablas a la plantilla de entrada para su rellenado
  85. wb <- loadWorkbook(file)
  86. writeData(wb, "NHC", upd.ovid)
  87. if (samples.mod){writeData(wb,"samples",samples.exp)}
  88. if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)}
  89. saveWorkbook(wb,file,overwrite = TRUE)
  90. }
  91. sqlSincBD<-function(conn=dta, filetemp="QueryOV.xlsx", sinc.samples=F, sinc.clinics=F){
  92. ## Añadir código de muestra nueva a la base de datos
  93. nsamples<-sqlFetch(conn, "SAMPLES") %>% nrow
  94. upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T)
  95. if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character}
  96. if (sinc.samples & nrow(upd.samples) > 0){
  97. upd.samples$IQ_date<-as.Date(upd.samples$IQ_date)
  98. upd.samples$TIL_date<-as.Date(upd.samples$TIL_date)
  99. ### !! Atención, esto cambia la base de datos:
  100. sqlSave(conn, upd.samples, tablename="SAMPLES", append = T, varTypes = c("IQ_date"="date","TIL_date"="date"))
  101. print("Tabla SAMPLES sincronizada.")
  102. }
  103. ## Añadir datos clínicos modificados a la base de datos
  104. upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T)
  105. ovid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))]
  106. rnames<-sqlFetch(conn, "CLINICS") %>% filter(OVID %in% ovid.mod) %>% rownames
  107. clinics.mod<-upd.clinics %>% filter(OVID %in% ovid.mod) %>% select(-NHC)
  108. rownames(clinics.mod)<-rnames
  109. ### !! Atención, esto cambia la base de datos:
  110. if (sinc.clinics){
  111. fechas<-colnames(clinics.mod)[grepl("DO|date", colnames(clinics.mod))]
  112. for (i in fechas){
  113. clinics.mod[,i]<-as.Date(clinics.mod[,i])
  114. }
  115. sqlUpdate(conn, clinics.mod,"CLINICS")
  116. print("Tabla CLINICS modificada.")
  117. }
  118. ## Añadir datos clínicos nuevos a la base de datos
  119. nsamples.clin<-sqlFetch(conn, "CLINICS") %>% nrow
  120. ovid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(conn, "CLINICS") %>% pull(OVID))]
  121. clinics.new<-upd.clinics %>% filter(OVID %in% ovid.new) %>% select(-NHC)
  122. if (length(ovid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character}
  123. ### !! Atención, esto cambia la base de datos:
  124. if (sinc.clinics){
  125. fechas<-colnames(clinics.new)[grepl("DO|date", colnames(clinics.new))]
  126. varTypes<-rep("Date",length(fechas))
  127. names(varTypes)<-fechas
  128. for (i in fechas){
  129. clinics.new[,i]<-as.Date(clinics.new[,i])
  130. }
  131. sqlSave(conn, clinics.new, tablename="CLINICS", append = T, varTypes = varTypes)
  132. print("Tabla CLINICS sincronizada.")
  133. }
  134. }