|
|
@ -24,13 +24,13 @@ ui <- fluidPage( |
|
|
|
navbarPage("BDAccess", |
|
|
|
tabPanel("Update", |
|
|
|
sidebarPanel( |
|
|
|
selectInput("dbtype", "", selected="UM", choices=c("UM", "OV")), |
|
|
|
selectInput("dbtype", "", selected="UM", choices=c("UM", "OV","CC")), |
|
|
|
checkboxInput(inputId = "backup", label="Backup", value=F), |
|
|
|
actionButton("butdbtype", "Carrega BD"), |
|
|
|
hr(), |
|
|
|
fileInput(inputId = "file_query", label = "Plantilla", multiple = F), |
|
|
|
actionButton("impNHC", "Importa NHC"), |
|
|
|
actionButton("goButton", "Genera CodiID"), |
|
|
|
actionButton("goButton", "Genera PATID"), |
|
|
|
hr(), |
|
|
|
actionButton("filltemplate", "Plantilla"), |
|
|
|
hr(), |
|
|
@ -79,6 +79,7 @@ server <- function(input, output) { |
|
|
|
observeEvent(input$butdbtype, { |
|
|
|
print(UMfile) |
|
|
|
print(OVfile) |
|
|
|
print(CCfile) |
|
|
|
if (input$dbtype == "UM"){ |
|
|
|
dta<<-odbcConnectAccess2007(access.file = UMfile, |
|
|
|
pwd = .rs.askForPassword("Enter password:")) |
|
|
@ -87,10 +88,18 @@ server <- function(input, output) { |
|
|
|
dta<<-odbcConnectAccess2007(access.file = OVfile, |
|
|
|
pwd = .rs.askForPassword("Enter password:")) |
|
|
|
} |
|
|
|
|
|
|
|
if (input$dbtype == "CC"){ |
|
|
|
dta<<-odbcConnectAccess2007(access.file = CCfile, |
|
|
|
pwd = .rs.askForPassword("Enter password:")) |
|
|
|
} |
|
|
|
print(dta) |
|
|
|
if (input$backup == T){ |
|
|
|
sqlBackUp() |
|
|
|
if (! input$dbtype %in% c("UM","OV")){ |
|
|
|
sqlBackUp(bu.dir="CC_BU") |
|
|
|
}else{ |
|
|
|
sqlBackUp() |
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
}) |
|
|
|
|
|
|
@ -218,14 +227,22 @@ server <- function(input, output) { |
|
|
|
|
|
|
|
observeEvent(input$goButton, { |
|
|
|
|
|
|
|
sqlGenOVID(dta, nhcs = values[["DF"]]$NHC, sinc=T) |
|
|
|
|
|
|
|
if (input$dbtype %in% c("UM","OV")){ |
|
|
|
sqlGenOVID(dta, nhcs = values[["DF"]]$NHC, sinc=T) |
|
|
|
} |
|
|
|
if (input$dbtype %in% c("CC")){ |
|
|
|
sqlGenOVID(dta, nhcs = values[["DF"]]$NHC, sinc=T, dbtype = input$dbtype) |
|
|
|
} |
|
|
|
|
|
|
|
if (input$dbtype == "UM"){ |
|
|
|
values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "UMID")) |
|
|
|
} |
|
|
|
if (input$dbtype == "OV"){ |
|
|
|
values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "OVID")) |
|
|
|
} |
|
|
|
if (input$dbtype == "CC"){ |
|
|
|
values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "PATID")) |
|
|
|
} |
|
|
|
print(values[["DF"]]) |
|
|
|
}) |
|
|
|
|
|
|
@ -315,6 +332,61 @@ server <- function(input, output) { |
|
|
|
values[["CLINICS"]]<-upd.clinics %>% mutate(across(lubridate::is.POSIXct, as.character)) |
|
|
|
} |
|
|
|
|
|
|
|
if (input$dbtype %in% c("CC")){ |
|
|
|
upd.umid<-sqlFetch(dta, "PATID") %>% filter(NHC %in% values[["DF"]]$NHC) |
|
|
|
## Generar código para las nuevas muestras |
|
|
|
samples<-sqlFetch(dta, "MUESTRAS") |
|
|
|
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 |
|
|
|
}else{ |
|
|
|
next.samp<-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.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) |
|
|
|
if (today==TRUE){ |
|
|
|
samples.exp$FECHA_RECEPCION<-format(Sys.Date(), "%d/%m/%y") |
|
|
|
} |
|
|
|
|
|
|
|
nhc.table<-values[["DF"]] |
|
|
|
|
|
|
|
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"] |
|
|
|
umid.cnag<-sqlFetch(dta, "PATID") %>% filter(NHC %in% nhcs.cnag) %>% pull(PATID) |
|
|
|
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") %>% slice(0), all=T) |
|
|
|
if (today==TRUE){ |
|
|
|
cnag.exp$FECHA_ENVIO<-format(Sys.Date(), "%d/%m/%y") |
|
|
|
} |
|
|
|
}else{ |
|
|
|
cnag.exp<-sqlFetch(dta, "CNAG") %>% slice(0) %>% |
|
|
|
mutate(across(lubridate::is.POSIXct, as.character)) |
|
|
|
} |
|
|
|
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"] |
|
|
|
umid.rna<-sqlFetch(dta, "PATID") %>% filter(NHC %in% nhcs.rna) %>% pull(PATID) |
|
|
|
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") %>% slice(0)%>% |
|
|
|
mutate(across(lubridate::is.POSIXct, as.character)), all=T) |
|
|
|
}else{ |
|
|
|
rna.exp<-sqlFetch(dta, "RNADNA") %>% slice(0) %>% |
|
|
|
mutate(across(lubridate::is.POSIXct, as.character)) |
|
|
|
} |
|
|
|
|
|
|
|
## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos |
|
|
|
upd.clinics<-sqlFetch(dta, "CLINICOS") |
|
|
|
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$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])} |
|
|
|
|
|
|
|
values[["samples"]]<-samples.exp |
|
|
|
values[["CLINICS"]]<-upd.clinics |
|
|
|
values[["cnag"]]<-cnag.exp |
|
|
|
values[["rna"]]<-rna.exp |
|
|
|
} |
|
|
|
|
|
|
|
}) |
|
|
|
|
|
|
|
observeEvent(input$synctemplate,{ |
|
|
|