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.

334 lines
15 KiB

2 years ago
2 years ago
  1. require(RODBC)
  2. sqlLastDrop<-function(conn, tablename, droplast=1,dbtype=NULL){
  3. if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
  4. if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
  5. table<-sqlFetch(conn, tablename)
  6. table<-table[1:(nrow(table)-droplast),]
  7. if (dbtype == "OV"){sqlSave(conn, table, tablename = tablename, safer = F)}
  8. if (dbtype == "UM"){
  9. sqlDrop(conn, tablename)
  10. sqlSave(conn, table, tablename = tablename, safer = F)}
  11. }
  12. sqlInitialize<-function(ruta="ruta_database.R"){
  13. library(tidyverse)
  14. library(RODBC)
  15. library(openxlsx)
  16. ## Conexión a la base de datos
  17. source(ruta, encoding = "UTF-8")
  18. }
  19. sqlBackUp<-function(dbfile=file,conn=dta,bu.dir=NULL){
  20. if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){bu.dir<-"BU_UM"}
  21. if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){bu.dir<-"BU_OVARIO"}
  22. db=strsplit(dbfile, "/")[[1]]%>% tail(n=1)
  23. bu_path<-gsub(db,bu.dir,dbfile)
  24. if (!dir.exists(bu_path)){
  25. dir.create(bu_path)
  26. print(paste0("Back Up directory ", bu_path, " created"))
  27. }
  28. cp_bu<-paste0(bu_path, "/", format(Sys.time(), format="%Y%m%d"),"-",db)
  29. file.copy(dbfile, cp_bu)
  30. }
  31. sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F, dbtype=NULL){
  32. if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
  33. if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
  34. if (dbtype == "OV"){
  35. db<-c("dbtables"="SAMPLES", "dbcode"="OVID", "dbsamples"="samples")
  36. query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"])
  37. }
  38. if (dbtype == "UM"){
  39. db<-c("dbtables"="MUESTRAS", "dbcode"="UMID", "dbsamples"="CODIGO")
  40. query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"])
  41. }
  42. if (nrow(sqlQuery(conn, query) %>% filter(NHC %in% nhcs)) == 0){
  43. return("No hay muestras de ningún paciente.")
  44. }
  45. if (isFALSE(verb)){
  46. sqlQuery(conn, query) %>% filter(NHC %in% nhcs) %>%
  47. group_by(NHC,UQ(rlang::sym(db["dbcode"]))) %>% summarise(Samples=length(UQ(rlang::sym(db["dbsamples"]))), Names=paste0(UQ(rlang::sym(db["dbsamples"])), collapse = ";")) %>%
  48. merge(data.frame(NHC=nhcs),all=T) %>% mutate(NHC=factor(NHC,levels = unique(nhcs))) %>% arrange(NHC)
  49. }else{
  50. sqlQuery(conn, query) %>% filter(NHC %in% nhcs)
  51. }
  52. }
  53. sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL){
  54. if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
  55. if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
  56. if (dbtype == "OV"){
  57. db<-c("dbcode"="OVID")
  58. }
  59. if (dbtype == "UM"){
  60. db<-c("dbcode"="UMID")
  61. }
  62. dbid<-sqlFetch(conn,db["dbcode"])
  63. new.nhc<-nhcs[!nhcs %in% dbid$NHC] %>% unique()
  64. if(length(new.nhc) > 0){
  65. next.num<-gsub(db["dbcode"],"",dbid[,db["dbcode"]]) %>% as.numeric %>% max(na.rm=T)+1
  66. last.num<-next.num+(length(new.nhc)-1)
  67. newtab<-data.frame("NHC"=new.nhc, "ID"=sprintf("%s%04d",db["dbcode"],next.num:last.num)) %>% rename(!!db["dbcode"]:="ID")
  68. if(dbtype=="OV"){
  69. dbid<-rbind(dbid,newtab)
  70. }
  71. if(dbtype=="UM"){
  72. dbid<-merge(dbid, newtab, all=T) %>% select(NHC,UMID) %>% arrange(UMID)
  73. # dbid$Id<-as.numeric(rownames(dbid))
  74. dbid$NHC<-as.numeric(dbid$NHC)
  75. }
  76. rownames(dbid)<-as.character(1:nrow(dbid))
  77. dbid<-filter(dbid, NHC %in% new.nhc) %>% mutate(NHC=as.character(NHC))
  78. if (sinc){
  79. ### !! Atención, esto cambia la base de datos:
  80. sqlSave(conn, dbid, tablename=db["dbcode"], append = T, rownames = F)
  81. print("La base ha sido actualizada.")
  82. }
  83. if (verb){
  84. return(dbid)
  85. }
  86. }else{
  87. print("No hay pacientes nuevos.")
  88. }
  89. }
  90. sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T, dbtype=NULL, today=F){
  91. if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
  92. if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
  93. if (dbtype=="OV"){
  94. upd.ovid<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs)
  95. if (samples.mod){
  96. ## Generar código para las nuevas muestras
  97. samples<-sqlFetch(conn, "SAMPLES")
  98. if(sum(grepl(paste0("OV",Sys.time() %>% format("%y")), samples$samples)) > 0){
  99. next.samp<-gsub(paste0("OV",Sys.time() %>% format("%y")),"", samples$samples) %>% as.numeric %>% max(na.rm=T)+1
  100. }else{
  101. next.samp<-1
  102. }
  103. last.samp<-next.samp+(length(nhcs)-1)
  104. new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp)
  105. new.samp.df<-merge(sqlFetch(dta,"OVID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "samples"=new.samp))
  106. samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples)
  107. }
  108. if (clinics.mod){
  109. ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
  110. upd.clinics<-sqlFetch(conn, "CLINICS")
  111. ovid.new<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs)
  112. upd.clinics<-merge(ovid.new,upd.clinics, all.x=T, by="OVID")
  113. upd.clinics$NHC<-as.character(upd.clinics$NHC)
  114. for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])}
  115. }
  116. ## Exportar tablas a la plantilla de entrada para su rellenado
  117. wb <- loadWorkbook(file)
  118. writeData(wb, "NHC", upd.ovid)
  119. if (samples.mod){writeData(wb,"samples",samples.exp)}
  120. if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)}
  121. saveWorkbook(wb,file,overwrite = TRUE)
  122. }
  123. if (dbtype=="UM"){
  124. upd.umid<-sqlFetch(conn, "UMID") %>% filter(NHC %in% nhcs)
  125. if (samples.mod){
  126. ## Generar código para las nuevas muestras
  127. samples<-sqlFetch(conn, "MUESTRAS")
  128. if(sum(grepl(paste0("UM",Sys.time() %>% format("%y")), samples$CODIGO)) > 0){
  129. next.samp<-gsub(paste0("UM",Sys.time() %>% format("%y")),"", samples$CODIGO) %>% as.numeric %>% max(na.rm=T)+1
  130. }else{
  131. next.samp<-1
  132. }
  133. last.samp<-next.samp+(length(nhcs)-1)
  134. new.samp<-sprintf("UM%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp)
  135. new.samp.df<-data.frame("NHC"=nhcs, "CODIGO"=new.samp) %>% merge(sqlFetch(dta,"UMID"), all.x=T) %>% arrange(CODIGO)
  136. samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO)
  137. if (today==TRUE){
  138. samples.exp$FECHA_RECEPCION<-format(Sys.Date(), "%d/%m/%y")
  139. }
  140. }
  141. nhc.table<-read.xlsx(file, sheet = "NHC")
  142. if (any(sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]) == T)){
  143. nhcs.cnag<-nhc.table[sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]),"NHC"]
  144. umid.cnag<-sqlFetch(conn, "UMID") %>% filter(NHC %in% nhcs.cnag) %>% pull(UMID)
  145. sample.cnag<-samples.exp %>% filter(UMID %in% umid.cnag) %>% pull(CODIGO)
  146. cnag.exp<-merge(data.frame("UMID"=umid.cnag, "CODIGO"=sample.cnag), sqlFetch(dta, "CNAG") %>% slice(0), all=T)
  147. if (today==TRUE){
  148. cnag.exp$FECHA_ENVIO<-format(Sys.Date(), "%d/%m/%y")
  149. }
  150. }else{cnag.exp<-sqlFetch(dta, "CNAG") %>% slice(0)}
  151. if (any(sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]) == T)){
  152. nhcs.rna<-nhc.table[sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]),"NHC"]
  153. umid.rna<-sqlFetch(conn, "UMID") %>% filter(NHC %in% nhcs.rna) %>% pull(UMID)
  154. sample.rna<-samples.exp %>% filter(UMID %in% umid.rna) %>% pull(CODIGO)
  155. rna.exp<-merge(data.frame("UMID"=umid.rna, "CODIGO"=sample.rna), sqlFetch(dta, "RNADNA") %>% slice(0), all=T)
  156. }else{rna.exp<- sqlFetch(dta, "RNADNA") %>% slice(0)}
  157. if (clinics.mod){
  158. ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
  159. upd.clinics<-sqlFetch(conn, "CLINICOS")
  160. umid.new<-sqlFetch(conn, "UMID") %>% filter(NHC %in% nhcs)
  161. upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="UMID")
  162. upd.clinics$NHC<-as.character(upd.clinics$NHC)
  163. for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])}
  164. }
  165. ## Exportar tablas a la plantilla de entrada para su rellenado
  166. wb <- createWorkbook(file)
  167. addWorksheet(wb, "NHC")
  168. addWorksheet(wb, "samples")
  169. addWorksheet(wb, "CLINICS")
  170. addWorksheet(wb, "CNAG")
  171. addWorksheet(wb, "RNADNA")
  172. writeData(wb, "NHC", merge(nhc.table, upd.umid, sort = F))
  173. if (samples.mod){writeData(wb,"samples",samples.exp)}
  174. if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)}
  175. writeData(wb,"CNAG",cnag.exp)
  176. writeData(wb,"RNADNA",rna.exp)
  177. saveWorkbook(wb,file,overwrite = TRUE)
  178. }
  179. }
  180. sqlSincBD<-function(conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clinics=F, dbtype=NULL){
  181. if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
  182. if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
  183. ## Añadir código de muestra nueva a la base de datos
  184. if (dbtype == "OV"){
  185. print("DB OV detectada")
  186. nsamples<-sqlFetch(conn, "SAMPLES") %>% nrow
  187. upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T)
  188. if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character}
  189. if (sinc.samples & nrow(upd.samples) > 0){
  190. upd.samples$IQ_date<-as.Date(upd.samples$IQ_date)
  191. upd.samples$TIL_date<-as.Date(upd.samples$TIL_date)
  192. ### !! Atención, esto cambia la base de datos:
  193. sqlSave(conn, upd.samples, tablename="SAMPLES", append = T, varTypes = c("IQ_date"="date","TIL_date"="date"))
  194. print("Tabla SAMPLES sincronizada.")
  195. }
  196. }
  197. if (dbtype == "UM"){
  198. print("DB UM detectada")
  199. nsamples<-sqlFetch(conn, "MUESTRAS") %>% nrow
  200. upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T)
  201. if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character}
  202. if (sinc.samples & nrow(upd.samples) > 0){
  203. upd.samples$FECHA_RECEPCION<-as.Date(upd.samples$FECHA_RECEPCION)
  204. upd.samples$TIPO<-as.character(upd.samples$TIPO)
  205. upd.samples$OBS<-as.character(upd.samples$OBS)
  206. ### !! Atención, esto cambia la base de datos:
  207. sqlSave(conn, upd.samples, tablename="MUESTRAS", append = T, varTypes = c("FECHA_RECEPCION"="Date"), rownames = F)
  208. print("Tabla MUESTRAS sincronizada.")
  209. }
  210. }
  211. ## Añadir datos clínicos modificados a la base de datos
  212. if (dbtype == "OV"){
  213. upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T)
  214. ovid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))]
  215. rnames<-sqlFetch(conn, "CLINICS") %>% filter(OVID %in% ovid.mod) %>% rownames
  216. clinics.mod<-upd.clinics %>% filter(OVID %in% ovid.mod) %>% select(-NHC)
  217. rownames(clinics.mod)<-rnames
  218. ### !! Atención, esto cambia la base de datos:
  219. if (sinc.clinics){
  220. fechas<-colnames(clinics.mod)[grepl("DO|date", colnames(clinics.mod))]
  221. for (i in fechas){
  222. clinics.mod[,i]<-as.Date(clinics.mod[,i])
  223. }
  224. sqlUpdate(conn, clinics.mod,"CLINICS")
  225. print("Tabla CLINICS modificada.")
  226. }
  227. }
  228. if (dbtype == "UM"){
  229. upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T)
  230. umid.mod<-upd.clinics$UMID[upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))]
  231. rnames<-sqlFetch(conn, "CLINICOS") %>% filter(UMID %in% umid.mod) %>% rownames
  232. clinics.mod<-upd.clinics %>% filter(UMID %in% umid.mod) %>% select(-NHC)
  233. rownames(clinics.mod)<-rnames
  234. ### !! Atención, esto cambia la base de datos:
  235. if (sinc.clinics){
  236. fechas<-colnames(clinics.mod)[grepl("date|MET_DX|DoB", colnames(clinics.mod), ignore.case = T)]
  237. for (i in fechas){
  238. clinics.mod[,i]<-as.Date(clinics.mod[,i])
  239. }
  240. sqlUpdate(conn, clinics.mod,"CLINICOS", index="UMID")
  241. print("Tabla CLINICOS modificada.")
  242. }
  243. }
  244. ## Añadir datos clínicos nuevos a la base de datos
  245. if (dbtype == "OV"){
  246. nsamples.clin<-sqlFetch(conn, "CLINICS") %>% nrow
  247. ovid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(conn, "CLINICS") %>% pull(OVID))]
  248. clinics.new<-upd.clinics %>% filter(OVID %in% ovid.new) %>% select(-NHC)
  249. if (length(ovid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character}
  250. ### !! Atención, esto cambia la base de datos:
  251. if (sinc.clinics){
  252. fechas<-colnames(clinics.new)[grepl("DO|date", colnames(clinics.new))]
  253. varTypes<-rep("Date",length(fechas))
  254. names(varTypes)<-fechas
  255. for (i in fechas){
  256. clinics.new[,i]<-as.Date(clinics.new[,i])
  257. }
  258. sqlSave(conn, clinics.new, tablename="CLINICS", append = T, varTypes = varTypes)
  259. print("Tabla CLINICS sincronizada.")
  260. }
  261. }
  262. if (dbtype == "UM"){
  263. nsamples.clin<-sqlFetch(conn, "CLINICOS") %>% nrow
  264. umid.new<-upd.clinics$UMID[!upd.clinics$UMID %in% (sqlFetch(conn, "CLINICOS") %>% pull(UMID))]
  265. clinics.new<-upd.clinics %>% filter(UMID %in% umid.new) %>% select(-NHC)
  266. if (length(umid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character}
  267. ### !! Atención, esto cambia la base de datos:
  268. if (sinc.clinics){
  269. fechas<-colnames(clinics.new)[grepl("date|MET_DX|DoB", colnames(clinics.new), ignore.case = T)]
  270. varTypes<-rep("Date",length(fechas))
  271. names(varTypes)<-fechas
  272. for (i in fechas){
  273. clinics.new[,i]<-as.Date(clinics.new[,i])
  274. }
  275. sqlSave(conn, clinics.new, tablename="CLINICOS", append = T, varTypes = varTypes, rownames = F)
  276. print("Tabla CLINICOS sincronizada.")
  277. }
  278. }
  279. }
  280. sqlMultiSamples<-function(kbl=F, NHC=F, full=F){
  281. query<-sqlQuery(dta, "SELECT U.UMID,U.NHC,M.FECHA_RECEPCION,M.TIPO,M.CODIGO,C.CODIGO,R.CODIGO,R.ESTADO
  282. FROM ((UMID U
  283. LEFT OUTER JOIN MUESTRAS M ON U.UMID=M.UMID)
  284. LEFT OUTER JOIN CNAG C ON M.CODIGO=C.CODIGO)
  285. LEFT OUTER JOIN RNADNA R ON M.CODIGO=R.CODIGO") %>% rename("CNAG"="CODIGO.1","RNADNA"="CODIGO.2")
  286. if (full==F){query<- query %>% filter(!is.na(CODIGO))}
  287. if (NHC==F){query<- query %>% select(-NHC)}
  288. query<-query %>% mutate(
  289. CNAG=case_when(!is.na(CNAG)~"X",TRUE~""),
  290. RNADNA=case_when((!is.na(RNADNA) & (ESTADO=="ENV"))~"X",
  291. (!is.na(RNADNA) & (is.na(ESTADO)))~".",
  292. TRUE~"")
  293. ) %>% select(-ESTADO)
  294. if (kbl==T){
  295. query %>% kableExtra::kbl() %>% kableExtra::kable_styling(full_width = F, bootstrap_options = c("striped"))
  296. }else{
  297. return(query)
  298. }
  299. }