From b968de1fb1c4274593f588c899301c888209eff6 Mon Sep 17 00:00:00 2001 From: Costa <47926492N@ICO.SCS.local> Date: Wed, 2 Mar 2022 14:01:05 +0100 Subject: [PATCH] =?UTF-8?q?A=C3=B1adir=20aplicaci=C3=B3n=20shiny?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- BDAccess/app.R | 338 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 338 insertions(+) create mode 100644 BDAccess/app.R diff --git a/BDAccess/app.R b/BDAccess/app.R new file mode 100644 index 0000000..77f37fd --- /dev/null +++ b/BDAccess/app.R @@ -0,0 +1,338 @@ +library(shiny) +library(rhandsontable) + +print(getwd()) +print(file) +source("../sqlFunctions.R", encoding = "UTF-8") + +DF<-data.frame("NHC"="","Samples"="") +samples<-data.frame("UMID"="","UM"="") +CLINICS<-data.frame("UMID"="","UM"="") +cnag<-data.frame("UMID"="","UM"="") +rna<-data.frame("UMID"="","UM"="") + +# Cargar dependencias +sqlInitialize(ruta="../ruta_database.R") + + +ui <- fluidPage( + + # Application title + titlePanel("BDAccess"), + + sidebarLayout( + sidebarPanel( + selectInput("dbtype", "", selected="UM", choices=c("UM", "OV")), + 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 UMID"), + hr(), + actionButton("filltemplate", "Plantilla"), + hr(), + actionButton("synctemplate", "Sincronizar") + ), + + mainPanel( + tabsetPanel( + tabPanel("NHC", rHandsontableOutput("hot")), + tabPanel("Samples",rHandsontableOutput("samples")), + tabPanel("CLINICS",rHandsontableOutput("CLINICS")), + tabPanel("CNAG",rHandsontableOutput("cnag")), + tabPanel("RNADNA",rHandsontableOutput("rna")), + ) + ) + ) +) + +# Define server logic required to draw a histogram +server <- function(input, output) { + + values <- reactiveValues() + values[["DF"]]<-DF + values[["samples"]]<-samples + values[["CLINICS"]]<-CLINICS + values[["cnag"]]<-cnag + values[["rna"]]<-rna + values[["Excel"]]<-"" + + observeEvent(input$butdbtype, { + dta<<-odbcConnectAccess2007(access.file = file, + pwd = .rs.askForPassword("Enter password:")) + print(dta) + if (input$backup == T){ + sqlBackUp() + } + }) + + # observe({ + # if (!is.null(input$file_access)){ + # # Inicializar conexión + # dta<<-odbcConnectAccess2007(access.file = file, + # pwd = .rs.askForPassword("Enter password:")) + # print(dta) + # sqlBackUp() + # } + # }) + + observe({ + if (!is.null(input$file_query)){ + ## Importamos los NHC de las muestras nuevas + values[["Excel"]]<-read.xlsx(input$file_query$datapath, sheet = "NHC") %>% pull(NHC) %>% as.character() + } + }) + observeEvent(input$impNHC, { + values[["DF"]]$NHC<-values[["Excel"]] + }) + + ## Handsontable + observe({ + if (!is.null(input$hot)) { + DF = hot_to_r(input$hot) + } else { + if (is.null(values[["DF"]])){ + DF <- DF + } + else{ + DF <- values[["DF"]] + } + } + values[["DF"]] <- DF + }) + + output$hot <- renderRHandsontable({ + if (!is.null(DF)){ + rhandsontable(values[["DF"]], stretchH = "all", readOnly = F, useTypes = T) + } + }) + + observe({ + print(1) + if (!is.null(input$samples)) { + samples = hot_to_r(input$samples) + } else { + if (is.null(values[["samples"]])){ + samples <- samples + } + else{ + samples <- values[["samples"]] + } + } + values[["samples"]] <- samples + }) + + output$samples <- renderRHandsontable({ + if (!is.null(samples)){ + rhandsontable(values[["samples"]], stretchH = "all", readOnly = F, useTypes = T) + } + }) + + observe({ + if (!is.null(input$CLINICS)) { + CLINICS = hot_to_r(input$CLINICS) + } else { + if (is.null(values[["CLINICS"]])){ + CLINICS <- CLINICS + } + else{ + CLINICS <- values[["CLINICS"]] + } + } + values[["CLINICS"]] <- CLINICS + }) + + output$CLINICS <- renderRHandsontable({ + if (!is.null(CLINICS)){ + rhandsontable(values[["CLINICS"]], stretchH = "all", readOnly = F, useTypes = T) + } + }) + + observe({ + if (!is.null(input$cnag)) { + cnag = hot_to_r(input$cnag) + } else { + if (is.null(values[["cnag"]])){ + cnag <- cnag + } + else{ + cnag <- values[["cnag"]] + } + } + values[["cnag"]] <- cnag + }) + + output$cnag <- renderRHandsontable({ + if (!is.null(cnag)){ + rhandsontable(values[["cnag"]], stretchH = "all", readOnly = F, useTypes = T) + } + }) + + observe({ + if (!is.null(input$rna)) { + rna = hot_to_r(input$rna) + } else { + if (is.null(values[["rna"]])){ + rna <- rna + } + else{ + rna <- values[["rna"]] + } + } + values[["rna"]] <- rna + }) + + output$rna <- renderRHandsontable({ + if (!is.null(rna)){ + rhandsontable(values[["rna"]], stretchH = "all", readOnly = F, useTypes = T) + } + }) + + observeEvent(input$goButton, { + print(dta) + sqlGenOVID(nhcs = values[["DF"]]$NHC, sinc=T) + values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "UMID")) + print(values[["DF"]]) + }) + + observeEvent(input$filltemplate,{ + today=T + + upd.umid<-sqlFetch(dta, "UMID") %>% filter(NHC %in% values[["DF"]]$NHC) + ## Generar código para las nuevas muestras + samples<-sqlFetch(dta, "MUESTRAS") + 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 + }else{ + next.samp<-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.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) + 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, "UMID") %>% filter(NHC %in% nhcs.cnag) %>% pull(UMID) + 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") %>% 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, "UMID") %>% filter(NHC %in% nhcs.rna) %>% pull(UMID) + 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") %>% 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, "UMID") %>% filter(NHC %in% values[["DF"]]$NHC) + upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="UMID") + 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 + + print(values[["rna"]] %>% sapply(class)) + + }) + + observeEvent(input$synctemplate,{ + + # conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clinics=F, dbtype=NULL + + ## Nuevas entradas en MUESTRAS + nsamples<-values[["samples"]] %>% nrow + upd.samples<-values[["samples"]] + if (nrow(upd.samples) > 0){rownames(upd.samples)<-(nsamples+1):(nsamples+nrow(upd.samples)) %>% as.character} + + if (nrow(upd.samples) > 0){ + upd.samples$FECHA_RECEPCION<-lubridate::parse_date_time(upd.samples$FECHA_RECEPCION, c("d/m/Y","d/m/y")) %>% as.Date() + upd.samples$TIPO<-as.character(upd.samples$TIPO) + upd.samples$OBS<-as.character(upd.samples$OBS) + ### !! Atención, esto cambia la base de datos: + print(upd.samples) + sqlSave(dta, upd.samples, tablename="MUESTRAS", append = T, varTypes = c("FECHA_RECEPCION"="Date"), rownames = F) + print("Tabla MUESTRAS sincronizada.") + } + + ## Entradas modificadas en CLINICOS + upd.clinics<-values[["CLINICS"]] + umid.mod<-upd.clinics$UMID[upd.clinics$UMID %in% (sqlFetch(dta, "CLINICOS") %>% pull(UMID))] + rnames<-sqlFetch(dta, "CLINICOS") %>% filter(UMID %in% umid.mod) %>% rownames + clinics.mod<-upd.clinics %>% filter(UMID %in% umid.mod) %>% select(-NHC) + rownames(clinics.mod)<-rnames + + ### !! Atención, esto cambia la base de datos: + fechas<-colnames(clinics.mod)[grepl("date|MET_DX|DoB", colnames(clinics.mod), ignore.case = T)] + for (i in fechas){ + clinics.mod[,i]<-lubridate::parse_date_time(clinics.mod[,i], c("d/m/Y","d/m/y")) %>% as.Date() + } + sqlUpdate(dta, clinics.mod,"CLINICOS", index="UMID") + print("Tabla CLINICOS modificada.") + + ## Nuevas entradas en CLINICOS + nsamples.clin<-sqlFetch(dta, "CLINICOS") %>% nrow + 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) + 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: + fechas<-colnames(clinics.new)[grepl("date|MET_DX|DoB", colnames(clinics.new), ignore.case = T)] + varTypes<-rep("Date",length(fechas)) + names(varTypes)<-fechas + for (i in fechas){ + clinics.new[,i]<-lubridate::parse_date_time(clinics.new[,i], c("d/m/Y","d/m/y")) %>% as.Date() + } + sqlSave(dta, clinics.new, tablename="CLINICOS", append = T, varTypes = varTypes, rownames = F) + print("Tabla CLINICOS sincronizada.") + + ## Nuevas entradas en CNAG + if (nrow(values[["cnag"]]) > 0){ + cnag.sync<-values[["cnag"]] + fechas<-colnames(cnag.sync)[sqlFetch(dta, "CNAG") %>% sapply(lubridate::is.POSIXct)] + varTypes<-rep("Date",length(fechas)) + names(varTypes)<-fechas + print(fechas) + for (i in fechas){ + cnag.sync[,i]<-lubridate::parse_date_time(cnag.sync[,i], c("d/m/Y","d/m/y")) %>% as.Date() + } + sqlSave(dta, cnag.sync, tablename="CNAG", append = T, varTypes = varTypes, rownames = F) + } + + ## Nuevas entradas en RNADNA + if (nrow(values[["rna"]]) > 0){ + rna.sync<-values[["rna"]] + fechas<-colnames(rna.sync)[sqlFetch(dta, "RNADNA") %>% sapply(lubridate::is.POSIXct)] + varTypes<-rep("Date",length(fechas)) + names(varTypes)<-fechas + for (i in fechas){ + rna.sync[,i]<-lubridate::parse_date_time(rna.sync[,i], c("d/m/Y","d/m/y")) %>% as.Date() + } + sqlSave(dta, rna.sync, tablename="RNADNA", append = T, varTypes = varTypes, rownames = F) + } + }) + +} + +# Run the application +shinyApp(ui = ui, server = server)