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.

582 lines
20 KiB

  1. <div id="TOC">
  2. <ul>
  3. <li><a href="#sqldroplast">sqlDropLast</a></li>
  4. <li><a href="#sqlinitizalize">sqlInitizalize</a></li>
  5. <li><a href="#sqlbackup">sqlBackUp</a></li>
  6. <li><a href="#sqlshowsamples">sqlShowSamples</a></li>
  7. <li><a href="#sqlgenovid">sqlGenOVID</a></li>
  8. <li><a href="#sqlwritetemp">sqlWriteTemp</a></li>
  9. <li><a href="#sqlsincbd">sqlSincBD</a></li>
  10. <li><a href="#sqlmultisamples">sqlMultiSamples</a></li>
  11. </ul>
  12. </div>
  13. ---
  14. ## sqlDropLast
  15. ### Description
  16. Removes from Database the last (or the amount specified) entry.
  17. ### Usage
  18. sqlDropLast(conn, tablename, droplast=1, dbtype=NULL)
  19. ### Arguments
  20. Argument|Description
  21. ---|---
  22. conn|connection handle returned by odbcConnect.
  23. tablename|character: a database table name accessible from the connected DSN.
  24. droplast|the amount of lines to be removed from the table strating from tail. By default, it removes only 1 line.
  25. dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced.
  26. ### Details
  27. Removes from Database the last (or the amount specified) entry.
  28. ### Value
  29. Invisibly for success (and failures cause errors).
  30. ### Examples
  31. ```r
  32. dta<-odbcConnect("test")
  33. sqlDropLast(dta, "TableTest")
  34. ```
  35. ### Function
  36. ```r
  37. sqlDropLast<-function(conn, tablename, droplast=1,dbtype=NULL){
  38. if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
  39. if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
  40. table<-sqlFetch(conn, tablename)
  41. table<-table[1:(nrow(table)-droplast),]
  42. if (dbtype == "OV"){sqlSave(conn, table, tablename = tablename, safer = F)}
  43. if (dbtype == "UM"){
  44. sqlDrop(conn, tablename)
  45. sqlSave(conn, table, tablename = tablename, safer = F)}
  46. }
  47. ```
  48. ---
  49. ## sqlInitizalize
  50. ### Description
  51. Loads required libraries and gets the db location.
  52. ### Usage
  53. sqlInitialize()
  54. ### Arguments
  55. Argument|Description
  56. ---|---
  57. ### Details
  58. Loads required libraries and gets the db location from "ruta_database.R" file.
  59. ### Value
  60. Invisibly for success (and failures cause errors).
  61. ### Examples
  62. ```r
  63. sqlInitialize()
  64. ```
  65. ### Function
  66. ```r
  67. sqlInitialize<-function(){
  68. library(tidyverse)
  69. library(RODBC)
  70. library(openxlsx)
  71. ## Conexión a la base de datos
  72. source("ruta_database.R", encoding = "UTF-8")
  73. }
  74. ```
  75. ---
  76. ## sqlBackUp
  77. ### Description
  78. Creates a Back Up copy of the database.
  79. ### Usage
  80. sqlBackUp(dbfile=file,conn=dta,bu.dir=NULL)
  81. ### Arguments
  82. Argument|Description
  83. ---|---
  84. dbfile| Database File location.
  85. conn|connection handle returned by odbcConnect.
  86. bu.dir|Directory under the DB file where the back up will be placed. It defaults to NULL and is deduced from conn database.
  87. ### Details
  88. Creates a Back Up copy of the database. It adds the date in front of the back up file.
  89. ### Value
  90. Invisibly for success (and failures cause errors).
  91. ### Examples
  92. ```r
  93. sqlInitialize()
  94. sqlBackUp()
  95. ```
  96. ### Function
  97. ```r
  98. sqlBackUp<-function(dbfile=file,conn=dta,bu.dir=NULL){
  99. if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){bu.dir<-"BU_UM"}
  100. if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){bu.dir<-"BU_OVARIO"}
  101. db=strsplit(dbfile, "/")[[1]]%>% tail(n=1)
  102. bu_path<-gsub(db,bu.dir,dbfile)
  103. if (!dir.exists(bu_path)){
  104. dir.create(bu_path)
  105. print(paste0("Back Up directory ", bu_path, " created"))
  106. }
  107. cp_bu<-paste0(bu_path, "/", format(Sys.time(), format="%Y%m%d"),"-",db)
  108. file.copy(dbfile, cp_bu)
  109. }
  110. ```
  111. ---
  112. ## sqlShowSamples
  113. ### Description
  114. Shows if there are already samples from the specified NHCs.
  115. ### Usage
  116. sqlShowSamples(conn=dta, nhcs=nhc.test, verb=F, dbtype=NULL)
  117. ### Arguments
  118. Argument|Description
  119. ---|---
  120. conn|connection handle returned by odbcConnect.
  121. nhcs|Character vector with the NHCs to test.
  122. verb|Verbose: if TRUE, all the columns from "SAMPLES" table are printed.
  123. dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced.
  124. ### Details
  125. Takes the NHCs listed in the nhcs vector and checks if there are already samples from those patients.
  126. ### Value
  127. A data.frame with information about the patients.
  128. ### Examples
  129. ```r
  130. dta<-odbcConnect("test")
  131. nhc.test<-c("XXXXXXXX","XXXXXXX")
  132. sqlShowSamples()
  133. ```
  134. ### Function
  135. ```r
  136. sqlShowSamples<-function(conn=dta, nhcs=nhc.test, verb=F, dbtype=NULL){
  137. if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
  138. if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
  139. if (dbtype == "OV"){
  140. db<-c("dbtables"="SAMPLES", "dbcode"="OVID", "dbsamples"="samples")
  141. query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"])
  142. }
  143. if (dbtype == "UM"){
  144. db<-c("dbtables"="MUESTRAS", "dbcode"="UMID", "dbsamples"="CODIGO")
  145. query<-paste0("SELECT O.NHC,S.* FROM ",db["dbtables"]," S INNER JOIN ",db["dbcode"]," O ON O.",db["dbcode"],"=S.",db["dbcode"])
  146. }
  147. if (nrow(sqlQuery(conn, query) %>% filter(NHC %in% nhcs)) == 0){
  148. return("No hay muestras de ningún paciente.")
  149. }
  150. if (isFALSE(verb)){
  151. sqlQuery(conn, query) %>% filter(NHC %in% nhcs) %>%
  152. group_by(NHC,UQ(rlang::sym(db["dbcode"]))) %>% summarise(Samples=length(UQ(rlang::sym(db["dbsamples"]))), Names=paste0(UQ(rlang::sym(db["dbsamples"])), collapse = ";")) %>%
  153. merge(data.frame(NHC=nhcs),all=T) %>% mutate(NHC=factor(NHC,levels = nhcs)) %>% arrange(NHC)
  154. }else{
  155. sqlQuery(conn, query) %>% filter(NHC %in% nhcs)
  156. }
  157. }
  158. ```
  159. ---
  160. ## sqlGenOVID
  161. ### Description
  162. Generates new consecutive OVID or UMID code for the patients that are not found in the DB.
  163. ### Usage
  164. sqlGenOVID(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL)
  165. ### Arguments
  166. Argument|Description
  167. ---|---
  168. conn|connection handle returned by odbcConnect.
  169. nhcs|Character vector with the NHCs to test.
  170. verb|Verbose: if TRUE (default), it prints the data.frame with the generated OVID codes.
  171. sinc|If TRUE (default is FALSE for security), it adds the new entries to the "OVID" table in the DB.
  172. dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced.
  173. ### Details
  174. Generates new consecutive OVID or UMID code for the patients that are not found in the DB.
  175. ### Value
  176. If verb is TRUE, it returns a data.frame.
  177. ### Examples
  178. ```r
  179. dta<-odbcConnect("test")
  180. nhc.test<-c("XXXXXXXX","XXXXXXX")
  181. sqlGenOVID(sinc=T)
  182. ```
  183. ### Function
  184. ```r
  185. sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL){
  186. if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
  187. if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
  188. if (dbtype == "OV"){
  189. db<-c("dbcode"="OVID")
  190. }
  191. if (dbtype == "UM"){
  192. db<-c("dbcode"="UMID")
  193. }
  194. dbid<-sqlFetch(conn,db["dbcode"])
  195. new.nhc<-nhcs[!nhcs %in% dbid$NHC]
  196. next.num<-gsub(db["dbcode"],"",dbid[,db["dbcode"]]) %>% as.numeric %>% max(na.rm=T)+1
  197. last.num<-next.num+(length(new.nhc)-1)
  198. newtab<-data.frame("NHC"=new.nhc, "ID"=sprintf("%s%04d",db["dbcode"],next.num:last.num)) %>% rename(!!db["dbcode"]:="ID")
  199. if(dbtype=="OV"){
  200. dbid<-rbind(dbid,newtab)
  201. }
  202. if(dbtype=="UM"){
  203. dbid<-merge(dbid, newtab, all=T) %>% select(Id,NHC,UMID) %>% arrange(Id)
  204. dbid$Id<-as.numeric(rownames(dbid))
  205. dbid$NHC<-as.numeric(dbid$NHC)
  206. }
  207. rownames(dbid)<-as.character(1:nrow(dbid))
  208. dbid<-filter(dbid, NHC %in% new.nhc) %>% mutate(NHC=as.character(NHC))
  209. if (sinc){
  210. ### !! Atención, esto cambia la base de datos:
  211. sqlSave(conn, dbid, tablename=db["dbcode"], append = T)
  212. print("La base ha sido actualizada.")
  213. }
  214. if (verb){
  215. return(dbid)
  216. }
  217. }
  218. ```
  219. ---
  220. ## sqlWriteTemp
  221. ### Description
  222. Fills the Query Template file with the OVID or UMID and OV or UM newly generated codes.
  223. ### Usage
  224. sqlWriteTemp(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T, dbtype=NULL)
  225. ### Arguments
  226. Argument|Description
  227. ---|---
  228. conn|connection handle returned by odbcConnect.
  229. nhcs|Character vector with the NHCs to test.
  230. file|Template file that will be used to interact with the DB.
  231. samples.mod|If TRUE (default), it fills the "samples" template sheet.
  232. clinics.mod|If TRUE (default), it fills the "CLINICS" template sheet.
  233. dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced.
  234. ### Details
  235. 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.
  236. ### Value
  237. Invisibly for success (and failures cause errors).
  238. ### Examples
  239. ```r
  240. dta<-odbcConnect("test")
  241. nhc.test<-c("XXXXXXXX","XXXXXXX")
  242. sqlGenOVID(sinc=T)
  243. sqlWriteTemp()
  244. ```
  245. ### Function
  246. ```r
  247. sqlWriteTemp<-function(conn=dta, nhcs=nhc.test, file="queryOV.xlsx", samples.mod=T, clinics.mod=T, dbtype=NULL){
  248. if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
  249. if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
  250. if (dbtype=="OV"){
  251. upd.ovid<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs)
  252. if (samples.mod){
  253. ## Generar código para las nuevas muestras
  254. samples<-sqlFetch(conn, "SAMPLES")
  255. if(sum(grepl(paste0("OV",Sys.time() %>% format("%y")), samples$samples)) > 0){
  256. next.samp<-gsub(paste0("OV",Sys.time() %>% format("%y")),"", samples$samples) %>% as.numeric %>% max(na.rm=T)+1
  257. }else{
  258. next.samp<-1
  259. }
  260. last.samp<-next.samp+(length(nhcs)-1)
  261. new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp)
  262. new.samp.df<-merge(sqlFetch(dta,"OVID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "samples"=new.samp))
  263. samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples)
  264. }
  265. if (clinics.mod){
  266. ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
  267. upd.clinics<-sqlFetch(conn, "CLINICS")
  268. ovid.new<-sqlFetch(conn, "OVID") %>% filter(NHC %in% nhcs)
  269. upd.clinics<-merge(ovid.new,upd.clinics, all.x=T, by="OVID")
  270. upd.clinics$NHC<-as.character(upd.clinics$NHC)
  271. for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])}
  272. }
  273. ## Exportar tablas a la plantilla de entrada para su rellenado
  274. wb <- loadWorkbook(file)
  275. writeData(wb, "NHC", upd.ovid)
  276. if (samples.mod){writeData(wb,"samples",samples.exp)}
  277. if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)}
  278. saveWorkbook(wb,file,overwrite = TRUE)
  279. }
  280. if (dbtype=="UM"){
  281. upd.umid<-sqlFetch(conn, "UMID") %>% filter(NHC %in% nhcs)
  282. if (samples.mod){
  283. ## Generar código para las nuevas muestras
  284. samples<-sqlFetch(conn, "MUESTRAS")
  285. if(sum(grepl(paste0("UM",Sys.time() %>% format("%y")), samples$CODIGO)) > 0){
  286. next.samp<-gsub(paste0("UM",Sys.time() %>% format("%y")),"", samples$CODIGO) %>% as.numeric %>% max(na.rm=T)+1
  287. }else{
  288. next.samp<-1
  289. }
  290. last.samp<-next.samp+(length(nhcs)-1)
  291. new.samp<-sprintf("UM%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp)
  292. new.samp.df<-merge(sqlFetch(dta,"UMID") %>% merge(data.frame("NHC"=nhcs)), data.frame("NHC"=nhcs, "CODIGO"=new.samp))
  293. samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO)
  294. }
  295. if (clinics.mod){
  296. ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
  297. upd.clinics<-sqlFetch(conn, "CLINICOS")
  298. umid.new<-sqlFetch(conn, "UMID") %>% filter(NHC %in% nhcs)
  299. upd.clinics<-merge(umid.new,upd.clinics %>% select(-Id), all.x=T, by="UMID")
  300. upd.clinics$NHC<-as.character(upd.clinics$NHC)
  301. for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])}
  302. }
  303. ## Exportar tablas a la plantilla de entrada para su rellenado
  304. wb <- loadWorkbook(file)
  305. writeData(wb, "NHC", upd.umid)
  306. if (samples.mod){writeData(wb,"samples",samples.exp)}
  307. if (clinics.mod){writeData(wb,"CLINICS",upd.clinics)}
  308. saveWorkbook(wb,file,overwrite = TRUE)
  309. }
  310. }
  311. ```
  312. ---
  313. ## sqlSincBD
  314. ### Description
  315. Updates the DB with the information filled in the template file.
  316. ### Usage
  317. sqlSincBD(conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clinics=F, dbtype=NULL)
  318. ### Arguments
  319. Argument|Description
  320. ---|---
  321. conn|connection handle returned by odbcConnect.
  322. filetemp|Template file that will be used to interact with the DB.
  323. 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.
  324. 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.
  325. dbtype|used to manually specify the database type. It defaults to NULL and the type is deduced.
  326. ### Details
  327. 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.
  328. ### Value
  329. Invisibly for success (and failures cause errors).
  330. ### Examples
  331. ```r
  332. dta<-odbcConnect("test")
  333. nhc.test<-c("XXXXXXXX","XXXXXXX")
  334. sqlGenOVID(sinc=T)
  335. sqlWriteTemp()
  336. sqlSincBD(sinc.samples=T, sinc.clinics=T)
  337. ```
  338. ### Function
  339. ```r
  340. sqlSincBD<-function(conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clinics=F, dbtype=NULL){
  341. if(sqlTables(dta) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){dbtype<-"UM"}
  342. if(sqlTables(dta) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
  343. ## Añadir código de muestra nueva a la base de datos
  344. if (dbtype == "OV"){
  345. print("DB OV detectada")
  346. nsamples<-sqlFetch(conn, "SAMPLES") %>% nrow
  347. upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T)
  348. if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character}
  349. if (sinc.samples & nrow(upd.samples) > 0){
  350. upd.samples$IQ_date<-as.Date(upd.samples$IQ_date)
  351. upd.samples$TIL_date<-as.Date(upd.samples$TIL_date)
  352. ### !! Atención, esto cambia la base de datos:
  353. sqlSave(conn, upd.samples, tablename="SAMPLES", append = T, varTypes = c("IQ_date"="date","TIL_date"="date"))
  354. print("Tabla SAMPLES sincronizada.")
  355. }
  356. }
  357. if (dbtype == "UM"){
  358. print("DB UM detectada")
  359. nsamples<-sqlFetch(conn, "MUESTRAS") %>% nrow
  360. upd.samples<-read.xlsx(filetemp, sheet = "samples", detectDates = T)
  361. if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character}
  362. if (sinc.samples & nrow(upd.samples) > 0){
  363. upd.samples$FECHA_RECEPCION<-as.Date(upd.samples$FECHA_RECEPCION)
  364. upd.samples$TIPO<-as.character(upd.samples$TIPO)
  365. upd.samples$OBS<-as.character(upd.samples$OBS)
  366. ### !! Atención, esto cambia la base de datos:
  367. sqlSave(conn, upd.samples, tablename="MUESTRAS", append = T, varTypes = c("FECHA_RECEPCION"="Date"), rownames = F)
  368. print("Tabla MUESTRAS sincronizada.")
  369. }
  370. }
  371. ## Añadir datos clínicos modificados a la base de datos
  372. if (dbtype == "OV"){
  373. upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T)
  374. ovid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))]
  375. rnames<-sqlFetch(conn, "CLINICS") %>% filter(OVID %in% ovid.mod) %>% rownames
  376. clinics.mod<-upd.clinics %>% filter(OVID %in% ovid.mod) %>% select(-NHC)
  377. rownames(clinics.mod)<-rnames
  378. ### !! Atención, esto cambia la base de datos:
  379. if (sinc.clinics){
  380. fechas<-colnames(clinics.mod)[grepl("DO|date", colnames(clinics.mod))]
  381. for (i in fechas){
  382. clinics.mod[,i]<-as.Date(clinics.mod[,i])
  383. }
  384. sqlUpdate(conn, clinics.mod,"CLINICS")
  385. print("Tabla CLINICS modificada.")
  386. }
  387. }
  388. if (dbtype == "UM"){
  389. upd.clinics<-read.xlsx(filetemp, sheet = "CLINICS",detectDates = T)
  390. umid.mod<-upd.clinics$UMID[upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))]
  391. rnames<-sqlFetch(conn, "CLINICOS") %>% filter(UMID %in% umid.mod) %>% rownames
  392. clinics.mod<-upd.clinics %>% filter(UMID %in% umid.mod) %>% select(-NHC)
  393. rownames(clinics.mod)<-rnames
  394. ### !! Atención, esto cambia la base de datos:
  395. if (sinc.clinics){
  396. fechas<-colnames(clinics.mod)[grepl("date|MET_DX|DoB", colnames(clinics.mod), ignore.case = T)]
  397. for (i in fechas){
  398. clinics.mod[,i]<-as.Date(clinics.mod[,i])
  399. }
  400. sqlUpdate(conn, clinics.mod,"CLINICOS")
  401. print("Tabla CLINICOS modificada.")
  402. }
  403. }
  404. ## Añadir datos clínicos nuevos a la base de datos
  405. if (dbtype == "OV"){
  406. nsamples.clin<-sqlFetch(conn, "CLINICS") %>% nrow
  407. ovid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(conn, "CLINICS") %>% pull(OVID))]
  408. clinics.new<-upd.clinics %>% filter(OVID %in% ovid.new) %>% select(-NHC)
  409. if (length(ovid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character}
  410. ### !! Atención, esto cambia la base de datos:
  411. if (sinc.clinics){
  412. fechas<-colnames(clinics.new)[grepl("DO|date", colnames(clinics.new))]
  413. varTypes<-rep("Date",length(fechas))
  414. names(varTypes)<-fechas
  415. for (i in fechas){
  416. clinics.new[,i]<-as.Date(clinics.new[,i])
  417. }
  418. sqlSave(conn, clinics.new, tablename="CLINICS", append = T, varTypes = varTypes)
  419. print("Tabla CLINICS sincronizada.")
  420. }
  421. }
  422. if (dbtype == "UM"){
  423. nsamples.clin<-sqlFetch(conn, "CLINICOS") %>% nrow
  424. umid.new<-upd.clinics$UMID[!upd.clinics$UMID %in% (sqlFetch(conn, "CLINICOS") %>% pull(UMID))]
  425. clinics.new<-upd.clinics %>% filter(UMID %in% umid.new) %>% select(-NHC)
  426. if (length(umid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character}
  427. ### !! Atención, esto cambia la base de datos:
  428. if (sinc.clinics){
  429. fechas<-colnames(clinics.new)[grepl("date|MET_DX|DoB", colnames(clinics.new), ignore.case = T)]
  430. varTypes<-rep("Date",length(fechas))
  431. names(varTypes)<-fechas
  432. for (i in fechas){
  433. clinics.new[,i]<-as.Date(clinics.new[,i])
  434. }
  435. sqlSave(conn, clinics.new, tablename="CLINICOS", append = T, varTypes = varTypes)
  436. print("Tabla CLINICOS sincronizada.")
  437. }
  438. }
  439. }
  440. ```
  441. ---
  442. ## sqlMultiSamples
  443. ### Description
  444. Prints a table compiling information about laboratory samples, scRNAseq samples and RNA/DNA samples.
  445. ### Usage
  446. sqlMultiSamples(kbl=F, NHC=F, full=F)
  447. ### Arguments
  448. Argument|Description
  449. ---|---
  450. kbl|formats the output table with the kableEstra style. Defaults to F.
  451. NHC|adds the NHC to the table in addition to the UMID. Defaults to F.
  452. full|prints also the patients that doesn't appear in the MUESTRAS table. Defaults to F.
  453. ### Details
  454. Prints a table compiling information about laboratory samples, scRNAseq samples and RNA/DNA samples.
  455. ### Value
  456. A data.frame or a kableExtra table.
  457. ### Examples
  458. ```r
  459. dta<-odbcConnect("test")
  460. sqlMultiSamples()
  461. ```
  462. ### Function
  463. ```r
  464. sqlMultiSamples<-function(kbl=F, NHC=F, full=F){
  465. query<-sqlQuery(dta, "SELECT U.UMID,U.NHC,M.FECHA_RECEPCION,M.TIPO,M.CODIGO,C.CODIGO,R.CODIGO,R.ESTADO
  466. FROM ((UMID U
  467. LEFT OUTER JOIN MUESTRAS M ON U.UMID=M.UMID)
  468. LEFT OUTER JOIN CNAG C ON M.CODIGO=C.CODIGO)
  469. LEFT OUTER JOIN RNADNA R ON M.CODIGO=R.CODIGO") %>% rename("CNAG"="CODIGO.1","RNADNA"="CODIGO.2")
  470. if (full==F){query<- query %>% filter(!is.na(CODIGO))}
  471. if (NHC==F){query<- query %>% select(-NHC)}
  472. query<-query %>% mutate(
  473. CNAG=case_when(!is.na(CNAG)~"X",TRUE~""),
  474. RNADNA=case_when((!is.na(RNADNA) & (ESTADO=="ENV"))~"X",
  475. (!is.na(RNADNA) & (is.na(ESTADO)))~".",
  476. TRUE~"")
  477. ) %>% select(-ESTADO)
  478. if (kbl==T){
  479. query %>% kableExtra::kbl() %>% kableExtra::kable_styling(full_width = F, bootstrap_options = c("striped"))
  480. }else{
  481. return(query)
  482. }
  483. }
  484. ```