marcelcosta/BDAccess
1
0
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

Compare commits

base: marcelcosta/BDAccess:4c27e84cbd8491f029925de0980e2395060700d4
Branches Tags
marcelcosta/BDAccess:main marcelcosta/BDAccess:dev
..
compare: marcelcosta/BDAccess:dev
Branches Tags
marcelcosta/BDAccess:main marcelcosta/BDAccess:dev

5 Commits
4c27e84cbd .. dev

Author SHA1 Message Date
marcelcosta 560540cf1a Commit in cytometry. 2023-10-10 12:35:43 +02:00
marcelcosta bd52e8c452 Corrección nombre de fecha de extracción. Solución de bug. 2023-02-02 16:54:09 +01:00
marcelcosta 43b807cc63 Corrección de la función de backup. 2022-07-04 11:09:20 +02:00
marcelcosta cb38ea347d Añadir notificación de sincronización y backup de nitrógeno. 2022-07-04 11:08:45 +02:00
marcelcosta 6671939939 Cambiar sistema de pedir contraseña. 2022-07-04 10:58:27 +02:00
2 changed files with 78 additions and 67 deletions
Expand all files Collapse all files
BDAccess/app.R
+73 -60
View File
@@ -144,24 +144,28 @@ server <- function(input, output) {
print(CCfile) print(CCfile)
if (input$dbtype == "UM"){ if (input$dbtype == "UM"){
dta<<-odbcConnectAccess2007(access.file = UMfile, dta<<-odbcConnectAccess2007(access.file = UMfile,
pwd = .rs.askForPassword("Enter password:")) pwd = getPass::getPass("Enter password:"))
} }
if (input$dbtype == "OV"){ if (input$dbtype == "OV"){
dta<<-odbcConnectAccess2007(access.file = OVfile, dta<<-odbcConnectAccess2007(access.file = OVfile,
pwd = .rs.askForPassword("Enter password:")) pwd = getPass::getPass("Enter password:"))
} }
if (input$dbtype == "CC"){ if (input$dbtype == "CC"){
dta<<-odbcConnectAccess2007(access.file = CCfile, dta<<-odbcConnectAccess2007(access.file = CCfile,
pwd = .rs.askForPassword("Enter password:")) pwd = getPass::getPass("Enter password:"))
} }
print(dta) print(dta)
if (input$backup == T){ if (input$backup == T){
if (! input$dbtype %in% c("UM","OV")){ if (! input$dbtype %in% c("UM","OV")){
sqlBackUp(bu.dir="CC_BU") sqlBackUp(dbfile = CCfile, bu.dir="CC_BU")
}else{
sqlBackUp()
} }
if (input$dbtype == "UM"){
sqlBackUp(dbfile = UMfile)
}
if (input$dbtype == "OV"){
sqlBackUp(dbfile = OVfile)
}
print("Back up realizado.")
} }
}) })
@@ -299,13 +303,13 @@ server <- function(input, output) {
} }
if (input$dbtype == "UM"){ if (input$dbtype == "UM"){
values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "UMID", as.is=T)) values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "UMID"))
} }
if (input$dbtype == "OV"){ if (input$dbtype == "OV"){
values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "OVID", as.is=T)) values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "OVID"))
} }
if (input$dbtype == "CC"){ if (input$dbtype == "CC"){
values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "PATID", as.is=T)) values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "PATID"))
} }
print(values[["DF"]]) print(values[["DF"]])
}) })
@@ -313,9 +317,9 @@ server <- function(input, output) {
observeEvent(input$filltemplate,{ observeEvent(input$filltemplate,{
today=T today=T
if (input$dbtype == "UM"){ if (input$dbtype == "UM"){
upd.umid<-sqlFetch(dta, "UMID", as.is=T) %>% filter(NHC %in% values[["DF"]]$NHC) upd.umid<-sqlFetch(dta, "UMID") %>% filter(NHC %in% values[["DF"]]$NHC)
## Generar código para las nuevas muestras ## Generar código para las nuevas muestras
samples<-sqlFetch(dta, "MUESTRAS", as.is=T) samples<-sqlFetch(dta, "MUESTRAS")
if(sum(grepl(paste0("UM",Sys.time() %>% format("%y")), samples$CODIGO)) > 0){ 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 next.samp<-gsub(paste0("UM",Sys.time() %>% format("%y")),"", samples$CODIGO) %>% as.numeric %>% max(na.rm=T)+1
}else{ }else{
@@ -323,7 +327,7 @@ server <- function(input, output) {
} }
last.samp<-next.samp+(length(values[["DF"]]$NHC)-1) last.samp<-next.samp+(length(values[["DF"]]$NHC)-1)
new.samp<-sprintf("UM%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp) new.samp<-sprintf("UM%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp)
new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "CODIGO"=new.samp) %>% merge(sqlFetch(dta,"UMID", as.is=T), all.x=T) %>% arrange(CODIGO) new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "CODIGO"=new.samp) %>% merge(sqlFetch(dta,"UMID"), all.x=T) %>% arrange(CODIGO)
samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO) samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO)
if (today==TRUE){ if (today==TRUE){
samples.exp$FECHA_RECEPCION<-format(Sys.Date(), "%d/%m/%y") samples.exp$FECHA_RECEPCION<-format(Sys.Date(), "%d/%m/%y")
@@ -333,30 +337,30 @@ server <- function(input, output) {
if (any(sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]) == T)){ if (any(sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]) == T)){
nhcs.cnag<-nhc.table[sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]),"NHC"] nhcs.cnag<-nhc.table[sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]),"NHC"]
umid.cnag<-sqlFetch(dta, "UMID", as.is=T) %>% filter(NHC %in% nhcs.cnag) %>% pull(UMID) umid.cnag<-sqlFetch(dta, "UMID") %>% filter(NHC %in% nhcs.cnag) %>% pull(UMID)
sample.cnag<-samples.exp %>% filter(UMID %in% umid.cnag) %>% pull(CODIGO) sample.cnag<-samples.exp %>% filter(UMID %in% umid.cnag) %>% pull(CODIGO)
cnag.exp<-merge(data.frame("UMID"=umid.cnag, "CODIGO"=sample.cnag), sqlFetch(dta, "CNAG", as.is=T) %>% slice(0), all=T) cnag.exp<-merge(data.frame("UMID"=umid.cnag, "CODIGO"=sample.cnag), sqlFetch(dta, "CNAG") %>% slice(0), all=T)
if (today==TRUE){ if (today==TRUE){
cnag.exp$FECHA_ENVIO<-format(Sys.Date(), "%d/%m/%y") cnag.exp$FECHA_ENVIO<-format(Sys.Date(), "%d/%m/%y")
} }
}else{ }else{
cnag.exp<-sqlFetch(dta, "CNAG", as.is=T) %>% slice(0) %>% cnag.exp<-sqlFetch(dta, "CNAG") %>% slice(0) %>%
mutate(across(lubridate::is.POSIXct, as.character)) mutate(across(lubridate::is.POSIXct, as.character))
} }
if (any(sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]) == T)){ if (any(sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]) == T)){
nhcs.rna<-nhc.table[sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]),"NHC"] nhcs.rna<-nhc.table[sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]),"NHC"]
umid.rna<-sqlFetch(dta, "UMID", as.is=T) %>% filter(NHC %in% nhcs.rna) %>% pull(UMID) umid.rna<-sqlFetch(dta, "UMID") %>% filter(NHC %in% nhcs.rna) %>% pull(UMID)
sample.rna<-samples.exp %>% filter(UMID %in% umid.rna) %>% pull(CODIGO) sample.rna<-samples.exp %>% filter(UMID %in% umid.rna) %>% pull(CODIGO)
rna.exp<-merge(data.frame("UMID"=umid.rna, "CODIGO"=sample.rna), sqlFetch(dta, "RNADNA", as.is=T) %>% slice(0)%>% rna.exp<-merge(data.frame("UMID"=umid.rna, "CODIGO"=sample.rna), sqlFetch(dta, "RNADNA") %>% slice(0)%>%
mutate(across(lubridate::is.POSIXct, as.character)), all=T) mutate(across(lubridate::is.POSIXct, as.character)), all=T)
}else{ }else{
rna.exp<-sqlFetch(dta, "RNADNA", as.is=T) %>% slice(0) %>% rna.exp<-sqlFetch(dta, "RNADNA") %>% slice(0) %>%
mutate(across(lubridate::is.POSIXct, as.character)) mutate(across(lubridate::is.POSIXct, as.character))
} }
## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
upd.clinics<-sqlFetch(dta, "CLINICOS", as.is=T) upd.clinics<-sqlFetch(dta, "CLINICOS")
umid.new<-sqlFetch(dta, "UMID", as.is=T) %>% filter(NHC %in% values[["DF"]]$NHC) umid.new<-sqlFetch(dta, "UMID") %>% filter(NHC %in% values[["DF"]]$NHC)
upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="UMID") upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="UMID")
upd.clinics$NHC<-as.character(upd.clinics$NHC) 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])} for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])}
@@ -367,9 +371,9 @@ server <- function(input, output) {
values[["rna"]]<-rna.exp values[["rna"]]<-rna.exp
} }
if (input$dbtype == "OV"){ if (input$dbtype == "OV"){
upd.umid<-sqlFetch(dta, "OVID", as.is=T) %>% filter(NHC %in% values[["DF"]]$NHC) upd.umid<-sqlFetch(dta, "OVID") %>% filter(NHC %in% values[["DF"]]$NHC)
## Generar código para las nuevas muestras ## Generar código para las nuevas muestras
samples<-sqlFetch(dta, "SAMPLES", as.is=T) samples<-sqlFetch(dta, "SAMPLES")
if(sum(grepl(paste0("OV",Sys.time() %>% format("%y")), samples$samples)) > 0){ 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 next.samp<-gsub(paste0("OV",Sys.time() %>% format("%y")),"", samples$samples) %>% as.numeric %>% max(na.rm=T)+1
}else{ }else{
@@ -377,17 +381,17 @@ server <- function(input, output) {
} }
last.samp<-next.samp+(length(values[["DF"]]$NHC)-1) last.samp<-next.samp+(length(values[["DF"]]$NHC)-1)
new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp) new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp)
new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "samples"=new.samp) %>% merge(sqlFetch(dta,"OVID", as.is=T), all.x=T) %>% arrange(samples) new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "samples"=new.samp) %>% merge(sqlFetch(dta,"OVID"), all.x=T) %>% arrange(samples)
samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples) samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples)
if (today==TRUE){ if (today==TRUE){
samples.exp$IQ_date<-format(Sys.Date(), "%d/%m/%y") samples.exp$Date_extraction<-format(Sys.Date(), "%d/%m/%y")
} }
nhc.table<-values[["DF"]] nhc.table<-values[["DF"]]
## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
upd.clinics<-sqlFetch(dta, "CLINICS", as.is=T) upd.clinics<-sqlFetch(dta, "CLINICS")
umid.new<-sqlFetch(dta, "OVID", as.is=T) %>% filter(NHC %in% values[["DF"]]$NHC) umid.new<-sqlFetch(dta, "OVID") %>% filter(NHC %in% values[["DF"]]$NHC)
upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="OVID") upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="OVID")
upd.clinics$NHC<-as.character(upd.clinics$NHC) 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])} for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])}
@@ -397,9 +401,9 @@ server <- function(input, output) {
} }
if (input$dbtype %in% c("CC")){ if (input$dbtype %in% c("CC")){
upd.umid<-sqlFetch(dta, "PATID", as.is=T) %>% filter(NHC %in% values[["DF"]]$NHC) upd.umid<-sqlFetch(dta, "PATID") %>% filter(NHC %in% values[["DF"]]$NHC)
## Generar código para las nuevas muestras ## Generar código para las nuevas muestras
samples<-sqlFetch(dta, "MUESTRAS", as.is=T) samples<-sqlFetch(dta, "MUESTRAS")
if(sum(grepl(paste0(input$dbtype,Sys.time() %>% format("%y")), samples$CODIGO)) > 0){ if(sum(grepl(paste0(input$dbtype,Sys.time() %>% format("%y")), samples$CODIGO)) > 0){
next.samp<-gsub(paste0(input$dbtype,Sys.time() %>% format("%y")),"", samples$CODIGO) %>% as.numeric %>% max(na.rm=T)+1 next.samp<-gsub(paste0(input$dbtype,Sys.time() %>% format("%y")),"", samples$CODIGO) %>% as.numeric %>% max(na.rm=T)+1
}else{ }else{
@@ -407,7 +411,7 @@ server <- function(input, output) {
} }
last.samp<-next.samp+(length(values[["DF"]]$NHC)-1) last.samp<-next.samp+(length(values[["DF"]]$NHC)-1)
new.samp<-sprintf("%s%s%02d",input$dbtype,Sys.time() %>% format("%y"),next.samp:last.samp) new.samp<-sprintf("%s%s%02d",input$dbtype,Sys.time() %>% format("%y"),next.samp:last.samp)
new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "CODIGO"=new.samp) %>% merge(sqlFetch(dta,"PATID", as.is=T), all.x=T) %>% arrange(CODIGO) new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "CODIGO"=new.samp) %>% merge(sqlFetch(dta,"PATID"), all.x=T) %>% arrange(CODIGO)
samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO) samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(CODIGO)
if (today==TRUE){ if (today==TRUE){
samples.exp$FECHA_RECEPCION<-format(Sys.Date(), "%d/%m/%y") samples.exp$FECHA_RECEPCION<-format(Sys.Date(), "%d/%m/%y")
@@ -417,30 +421,30 @@ server <- function(input, output) {
if (any(sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]) == T)){ if (any(sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]) == T)){
nhcs.cnag<-nhc.table[sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]),"NHC"] nhcs.cnag<-nhc.table[sapply(nhc.table$Samples, function(x) "cnag" %in% strsplit(x,",")[[1]]),"NHC"]
umid.cnag<-sqlFetch(dta, "PATID", as.is=T) %>% filter(NHC %in% nhcs.cnag) %>% pull(PATID) umid.cnag<-sqlFetch(dta, "PATID") %>% filter(NHC %in% nhcs.cnag) %>% pull(PATID)
sample.cnag<-samples.exp %>% filter(PATID %in% umid.cnag) %>% pull(CODIGO) sample.cnag<-samples.exp %>% filter(PATID %in% umid.cnag) %>% pull(CODIGO)
cnag.exp<-merge(data.frame("PATID"=umid.cnag, "CODIGO"=sample.cnag), sqlFetch(dta, "CNAG", as.is=T) %>% slice(0), all=T) cnag.exp<-merge(data.frame("PATID"=umid.cnag, "CODIGO"=sample.cnag), sqlFetch(dta, "CNAG") %>% slice(0), all=T)
if (today==TRUE){ if (today==TRUE){
cnag.exp$FECHA_ENVIO<-format(Sys.Date(), "%d/%m/%y") cnag.exp$FECHA_ENVIO<-format(Sys.Date(), "%d/%m/%y")
} }
}else{ }else{
cnag.exp<-sqlFetch(dta, "CNAG", as.is=T) %>% slice(0) %>% cnag.exp<-sqlFetch(dta, "CNAG") %>% slice(0) %>%
mutate(across(lubridate::is.POSIXct, as.character)) mutate(across(lubridate::is.POSIXct, as.character))
} }
if (any(sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]) == T)){ if (any(sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]) == T)){
nhcs.rna<-nhc.table[sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]),"NHC"] nhcs.rna<-nhc.table[sapply(nhc.table$Samples, function(x) "rna" %in% strsplit(x,",")[[1]]),"NHC"]
umid.rna<-sqlFetch(dta, "PATID", as.is=T) %>% filter(NHC %in% nhcs.rna) %>% pull(PATID) umid.rna<-sqlFetch(dta, "PATID") %>% filter(NHC %in% nhcs.rna) %>% pull(PATID)
sample.rna<-samples.exp %>% filter(PATID %in% umid.rna) %>% pull(CODIGO) sample.rna<-samples.exp %>% filter(PATID %in% umid.rna) %>% pull(CODIGO)
rna.exp<-merge(data.frame("PATID"=umid.rna, "CODIGO"=sample.rna), sqlFetch(dta, "RNADNA", as.is=T) %>% slice(0)%>% rna.exp<-merge(data.frame("PATID"=umid.rna, "CODIGO"=sample.rna), sqlFetch(dta, "RNADNA") %>% slice(0)%>%
mutate(across(lubridate::is.POSIXct, as.character)), all=T) mutate(across(lubridate::is.POSIXct, as.character)), all=T)
}else{ }else{
rna.exp<-sqlFetch(dta, "RNADNA", as.is=T) %>% slice(0) %>% rna.exp<-sqlFetch(dta, "RNADNA") %>% slice(0) %>%
mutate(across(lubridate::is.POSIXct, as.character)) mutate(across(lubridate::is.POSIXct, as.character))
} }
## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos ## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
upd.clinics<-sqlFetch(dta, "CLINICOS", as.is=T) upd.clinics<-sqlFetch(dta, "CLINICOS")
umid.new<-sqlFetch(dta, "PATID", as.is=T) %>% filter(NHC %in% values[["DF"]]$NHC) umid.new<-sqlFetch(dta, "PATID") %>% filter(NHC %in% values[["DF"]]$NHC)
upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="PATID") upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="PATID")
upd.clinics$NHC<-as.character(upd.clinics$NHC) 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])} for (i in colnames(upd.clinics)[sapply(upd.clinics, lubridate::is.POSIXct)]){upd.clinics[,i]<-as.Date(upd.clinics[,i])}
@@ -473,8 +477,8 @@ server <- function(input, output) {
## Entradas modificadas en CLINICOS ## Entradas modificadas en CLINICOS
upd.clinics<-values[["CLINICS"]] upd.clinics<-values[["CLINICS"]]
umid.mod<-upd.clinics$UMID[upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS", as.is=T) %>% pull(UMID))] umid.mod<-upd.clinics$UMID[upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))]
rnames<-sqlFetch(dta, "CLINICOS", as.is=T) %>% filter(UMID %in% umid.mod) %>% rownames rnames<-sqlFetch(dta, "CLINICOS") %>% filter(UMID %in% umid.mod) %>% rownames
clinics.mod<-upd.clinics %>% filter(UMID %in% umid.mod) %>% select(-NHC) clinics.mod<-upd.clinics %>% filter(UMID %in% umid.mod) %>% select(-NHC)
rownames(clinics.mod)<-rnames rownames(clinics.mod)<-rnames
@@ -487,8 +491,8 @@ server <- function(input, output) {
print("Tabla CLINICOS modificada.") print("Tabla CLINICOS modificada.")
## Nuevas entradas en CLINICOS ## Nuevas entradas en CLINICOS
nsamples.clin<-sqlFetch(dta, "CLINICOS", as.is=T) %>% nrow nsamples.clin<-sqlFetch(dta, "CLINICOS") %>% nrow
umid.new<-upd.clinics$UMID[!upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS", as.is=T) %>% pull(UMID))] umid.new<-upd.clinics$UMID[!upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))]
clinics.new<-upd.clinics %>% filter(UMID %in% umid.new) %>% select(-NHC) 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} if (length(umid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character}
@@ -505,7 +509,7 @@ server <- function(input, output) {
## Nuevas entradas en CNAG ## Nuevas entradas en CNAG
if (nrow(values[["cnag"]]) > 0){ if (nrow(values[["cnag"]]) > 0){
cnag.sync<-values[["cnag"]] cnag.sync<-values[["cnag"]]
fechas<-colnames(cnag.sync)[sqlFetch(dta, "CNAG", as.is=T) %>% sapply(lubridate::is.POSIXct)] fechas<-colnames(cnag.sync)[sqlFetch(dta, "CNAG") %>% sapply(lubridate::is.POSIXct)]
varTypes<-rep("Date",length(fechas)) varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas names(varTypes)<-fechas
print(fechas) print(fechas)
@@ -518,7 +522,7 @@ server <- function(input, output) {
## Nuevas entradas en RNADNA ## Nuevas entradas en RNADNA
if (nrow(values[["rna"]]) > 0){ if (nrow(values[["rna"]]) > 0){
rna.sync<-values[["rna"]] rna.sync<-values[["rna"]]
fechas<-colnames(rna.sync)[sqlFetch(dta, "RNADNA", as.is=T) %>% sapply(lubridate::is.POSIXct)] fechas<-colnames(rna.sync)[sqlFetch(dta, "RNADNA") %>% sapply(lubridate::is.POSIXct)]
varTypes<-rep("Date",length(fechas)) varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas names(varTypes)<-fechas
for (i in fechas){ for (i in fechas){
@@ -534,7 +538,7 @@ server <- function(input, output) {
if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character} if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character}
if (nrow(upd.samples) > 0){ if (nrow(upd.samples) > 0){
fechas<-colnames(upd.samples)[sqlFetch(dta, "SAMPLES", as.is=T) %>% sapply(lubridate::is.POSIXct)] fechas<-colnames(upd.samples)[sqlFetch(dta, "SAMPLES") %>% sapply(lubridate::is.POSIXct)]
for (i in fechas){ for (i in fechas){
upd.samples[,i]<-lubridate::parse_date_time(upd.samples[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date() upd.samples[,i]<-lubridate::parse_date_time(upd.samples[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date()
} }
@@ -549,14 +553,14 @@ server <- function(input, output) {
## Entradas modificadas en CLINICOS ## Entradas modificadas en CLINICOS
upd.clinics<-values[["CLINICS"]] upd.clinics<-values[["CLINICS"]]
umid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS", as.is=T) %>% pull(OVID))] umid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))]
rnames<-sqlFetch(dta, "CLINICS", as.is=T) %>% filter(OVID %in% umid.mod) %>% rownames rnames<-sqlFetch(dta, "CLINICS") %>% filter(OVID %in% umid.mod) %>% rownames
clinics.mod<-upd.clinics %>% filter(OVID %in% umid.mod) %>% select(-NHC) clinics.mod<-upd.clinics %>% filter(OVID %in% umid.mod) %>% select(-NHC)
rownames(clinics.mod)<-rnames rownames(clinics.mod)<-rnames
### !! Atención, esto cambia la base de datos: ### !! Atención, esto cambia la base de datos:
print(clinics.mod) print(clinics.mod)
fechas<-colnames(clinics.mod)[sqlFetch(dta, "CLINICS", as.is=T) %>% sapply(lubridate::is.POSIXct)] fechas<-colnames(clinics.mod)[sqlFetch(dta, "CLINICS") %>% sapply(lubridate::is.POSIXct)]
for (i in fechas){ for (i in fechas){
clinics.mod[,i]<-lubridate::parse_date_time(clinics.mod[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date() clinics.mod[,i]<-lubridate::parse_date_time(clinics.mod[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date()
} }
@@ -567,13 +571,13 @@ server <- function(input, output) {
print("Tabla CLINICS modificada.") print("Tabla CLINICS modificada.")
## Nuevas entradas en CLINICOS ## Nuevas entradas en CLINICOS
nsamples.clin<-sqlFetch(dta, "CLINICS", as.is=T) %>% nrow nsamples.clin<-sqlFetch(dta, "CLINICS") %>% nrow
umid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS", as.is=T) %>% pull(OVID))] umid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))]
clinics.new<-upd.clinics %>% filter(OVID %in% umid.new) %>% select(-NHC) clinics.new<-upd.clinics %>% filter(OVID %in% umid.new) %>% select(-NHC)
if (length(umid.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character} 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: ### !! Atención, esto cambia la base de datos:
fechas<-colnames(clinics.new)[sqlFetch(dta, "CLINICS", as.is=T) %>% sapply(lubridate::is.POSIXct)] fechas<-colnames(clinics.new)[sqlFetch(dta, "CLINICS") %>% sapply(lubridate::is.POSIXct)]
for (i in fechas){ for (i in fechas){
clinics.new[,i]<-lubridate::parse_date_time(clinics.new[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date() clinics.new[,i]<-lubridate::parse_date_time(clinics.new[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date()
} }
@@ -601,8 +605,8 @@ server <- function(input, output) {
## Entradas modificadas en CLINICOS ## Entradas modificadas en CLINICOS
upd.clinics<-values[["CLINICS"]] upd.clinics<-values[["CLINICS"]]
PATID.mod<-upd.clinics$PATID[upd.clinics$PATID %in% (sqlFetch(dta, "CLINICOS", as.is=T) %>% pull(PATID))] PATID.mod<-upd.clinics$PATID[upd.clinics$PATID %in% (sqlFetch(dta, "CLINICOS") %>% pull(PATID))]
rnames<-sqlFetch(dta, "CLINICOS", as.is=T) %>% filter(PATID %in% PATID.mod) %>% rownames rnames<-sqlFetch(dta, "CLINICOS") %>% filter(PATID %in% PATID.mod) %>% rownames
clinics.mod<-upd.clinics %>% filter(PATID %in% PATID.mod) %>% select(-NHC) clinics.mod<-upd.clinics %>% filter(PATID %in% PATID.mod) %>% select(-NHC)
rownames(clinics.mod)<-rnames rownames(clinics.mod)<-rnames
@@ -615,8 +619,8 @@ server <- function(input, output) {
print("Tabla CLINICOS modificada.") print("Tabla CLINICOS modificada.")
## Nuevas entradas en CLINICOS ## Nuevas entradas en CLINICOS
nsamples.clin<-sqlFetch(dta, "CLINICOS", as.is=T) %>% nrow nsamples.clin<-sqlFetch(dta, "CLINICOS") %>% nrow
PATID.new<-upd.clinics$PATID[!upd.clinics$PATID %in% (sqlFetch(dta, "CLINICOS", as.is=T) %>% pull(PATID))] PATID.new<-upd.clinics$PATID[!upd.clinics$PATID %in% (sqlFetch(dta, "CLINICOS") %>% pull(PATID))]
clinics.new<-upd.clinics %>% filter(PATID %in% PATID.new) %>% select(-NHC) clinics.new<-upd.clinics %>% filter(PATID %in% PATID.new) %>% select(-NHC)
if (length(PATID.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character} if (length(PATID.new) > 0){rownames(clinics.new)<-(nsamples.clin+1):(nsamples.clin+nrow(clinics.new)) %>% as.character}
@@ -633,7 +637,7 @@ server <- function(input, output) {
## Nuevas entradas en CNAG ## Nuevas entradas en CNAG
if (nrow(values[["cnag"]]) > 0){ if (nrow(values[["cnag"]]) > 0){
cnag.sync<-values[["cnag"]] cnag.sync<-values[["cnag"]]
fechas<-colnames(cnag.sync)[sqlFetch(dta, "CNAG", as.is=T) %>% sapply(lubridate::is.POSIXct)] fechas<-colnames(cnag.sync)[sqlFetch(dta, "CNAG") %>% sapply(lubridate::is.POSIXct)]
varTypes<-rep("Date",length(fechas)) varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas names(varTypes)<-fechas
print(fechas) print(fechas)
@@ -646,7 +650,7 @@ server <- function(input, output) {
## Nuevas entradas en RNADNA ## Nuevas entradas en RNADNA
if (nrow(values[["rna"]]) > 0){ if (nrow(values[["rna"]]) > 0){
rna.sync<-values[["rna"]] rna.sync<-values[["rna"]]
fechas<-colnames(rna.sync)[sqlFetch(dta, "RNADNA", as.is=T) %>% sapply(lubridate::is.POSIXct)] fechas<-colnames(rna.sync)[sqlFetch(dta, "RNADNA") %>% sapply(lubridate::is.POSIXct)]
varTypes<-rep("Date",length(fechas)) varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas names(varTypes)<-fechas
for (i in fechas){ for (i in fechas){
@@ -754,6 +758,7 @@ server <- function(input, output) {
sqlFetch(dta, "NITROGEN"), sqlFetch(dta, "NITROGEN"),
file=paste0(NitroRoute, format(Sys.time(), format="%Y%m%d"),"-","UM-Nitrogen.xlsx") file=paste0(NitroRoute, format(Sys.time(), format="%Y%m%d"),"-","UM-Nitrogen.xlsx")
) )
print("Backup Creado.")
table<-read.xlsx(paste0(gsub("/BU_NITRO/", "", NitroRoute),"/Nitrogen_ICO.xlsx")) table<-read.xlsx(paste0(gsub("/BU_NITRO/", "", NitroRoute),"/Nitrogen_ICO.xlsx"))
@@ -784,6 +789,7 @@ server <- function(input, output) {
sqlDrop(dta, "NITROGEN") sqlDrop(dta, "NITROGEN")
sqlSave(dta, table.um %>% select(-FECHA) %>% filter(!is.na(CODIGO)), tablename="NITROGEN", rownames=F) sqlSave(dta, table.um %>% select(-FECHA) %>% filter(!is.na(CODIGO)), tablename="NITROGEN", rownames=F)
print("Tabla Actualizada.")
} }
if (input$dbtype == "OV"){ if (input$dbtype == "OV"){
## Copia de backup ## Copia de backup
@@ -797,6 +803,7 @@ server <- function(input, output) {
sqlFetch(dta, "NITROGEN"), sqlFetch(dta, "NITROGEN"),
file=paste0(NitroRoute, format(Sys.time(), format="%Y%m%d"),"-","OV-Nitrogen.xlsx") file=paste0(NitroRoute, format(Sys.time(), format="%Y%m%d"),"-","OV-Nitrogen.xlsx")
) )
print("Backup Creado.")
## Lectura del excel ## Lectura del excel
table<-read.xlsx(paste0(gsub("/BU_NITRO/", "", NitroRoute),"/Nitrogen_ICO.xlsx")) table<-read.xlsx(paste0(gsub("/BU_NITRO/", "", NitroRoute),"/Nitrogen_ICO.xlsx"))
@@ -822,6 +829,7 @@ server <- function(input, output) {
sqlDrop(dta, "NITROGEN") sqlDrop(dta, "NITROGEN")
sqlSave(dta, table.ov, tablename="NITROGEN", rownames=F) sqlSave(dta, table.ov, tablename="NITROGEN", rownames=F)
print("Tabla Actualizada.")
} }
}) })
@@ -924,9 +932,14 @@ server <- function(input, output) {
pops<-sqlFetch(dta, "POPULATIONS") pops<-sqlFetch(dta, "POPULATIONS")
g_pop<-pops %>% dplyr::filter(samples == input$id) %>% gather(pop,value,-samples) %>% g_pop<-pops %>%
mutate(pop=factor(pop, levels=c("CD45pos_Alive","T_cells","CD8","CD4","DN","NK", "B_cells", dplyr::filter(sample == input$id) %>%
"CD45neg_LDneg","EpCAMneg_HLAIneg","EpCAMneg_HLAIpos","EpCAMpos_HLAIpos"))) %>% gather(pop,value,-sample, -code, -fc_time) %>%
# mutate(pop=factor(pop, levels=c("CD45pos_Alive","T_cells","CD8","CD4","DN","NK", "B_cells",
# "CD45neg_LDneg","EpCAMneg_HLAIneg","EpCAMneg_HLAIpos","EpCAMpos_HLAIpos"))) %>%
# mutate(pop=factor(pop, levels=c("CD45pos_Alive","T_cells","CD8","CD4","DN","NK", "B_cells",
# "CD45neg_LDneg","EpCAMneg_HLAIneg","EpCAMneg_HLAIpos","EpCAMpos_HLAIpos"))) %>%
mutate(value=as.numeric(gsub(",",".",value))) %>%
ggplot(aes(pop, value))+ ggplot(aes(pop, value))+
geom_bar(stat="identity", color="black", fill="grey70")+ geom_bar(stat="identity", color="black", fill="grey70")+
labs(title = input$id, y="% parent", x="")+ labs(title = input$id, y="% parent", x="")+
sqlFunctions.R
+4 -6
View File
@@ -15,7 +15,7 @@ sqlLastDrop<-function(conn, tablename, droplast=1,dbtype=NULL){
sqlInitialize<-function(ruta="ruta_database.R"){ sqlInitialize<-function(ruta="ruta_database.R"){
# library(tidyverse) library(tidyverse)
library(RODBC) library(RODBC)
library(openxlsx) library(openxlsx)
@@ -24,12 +24,10 @@ sqlInitialize<-function(ruta="ruta_database.R"){
} }
sqlBackUp<-function(dbfile=file,conn=dta,bu.dir=NULL){ sqlBackUp<-function(dbfile=file,conn=dta,bu.dir=NULL){
print(dbfile)
if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){bu.dir<-"BU_UM"} if(sqlTables(conn) %>% filter(TABLE_NAME == "UMID") %>% nrow > 0){bu.dir<-"BU_UM"}
if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){bu.dir<-"BU_OVARIO"} if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){bu.dir<-"BU_OVARIO"}
db=tail(strsplit(dbfile, "/")[[1]], n=1) db=strsplit(dbfile, "/")[[1]]%>% tail(n=1)
print(db)
bu_path<-gsub(db,bu.dir,dbfile) bu_path<-gsub(db,bu.dir,dbfile)
if (!dir.exists(bu_path)){ if (!dir.exists(bu_path)){
dir.create(bu_path) dir.create(bu_path)
@@ -77,7 +75,7 @@ sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL){
db<-c("dbcode"="PATID", "dbpref"="CCID") db<-c("dbcode"="PATID", "dbpref"="CCID")
} }
dbid<-sqlFetch(conn,db["dbcode"], as.is=T) dbid<-sqlFetch(conn,db["dbcode"])
new.nhc<-nhcs[!nhcs %in% dbid$NHC] %>% unique() new.nhc<-nhcs[!nhcs %in% dbid$NHC] %>% unique()
if(length(new.nhc) > 0){ if(length(new.nhc) > 0){
@@ -93,7 +91,7 @@ sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL){
if(dbtype=="UM"){ if(dbtype=="UM"){
dbid<-merge(dbid, newtab, all=T) %>% select(NHC,UMID) %>% arrange(UMID) dbid<-merge(dbid, newtab, all=T) %>% select(NHC,UMID) %>% arrange(UMID)
# dbid$Id<-as.numeric(rownames(dbid)) # dbid$Id<-as.numeric(rownames(dbid))
# dbid$NHC<-dbid$NHC dbid$NHC<-as.numeric(dbid$NHC)
} }
if (dbtype=="CC"){ if (dbtype=="CC"){
dbid<-merge(dbid, newtab, all=T) %>% select(NHC,PATID) %>% arrange(PATID) dbid<-merge(dbid, newtab, all=T) %>% select(NHC,PATID) %>% arrange(PATID)