Añadir cancer de cólon.

BDAccess/app.R

@@ -17,17 +17,20 @@ sqlInitialize(ruta="../ruta_database.R")
 ui <- fluidPage(
 
     # Application title
-    titlePanel("BDAccess"),
+    #titlePanel("BDAccess"),
     
-    sidebarLayout(
+    #sidebarLayout(
+    #Navbar
+    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(),
@@ -43,12 +46,28 @@ ui <- fluidPage(
                     tabPanel("RNADNA",rHandsontableOutput("rna")),
                 )
             )
+        ),
+        tabPanel("Visor",
+            sidebarPanel(
+                radioButtons("nhc", label = h3("Código"),
+                             choices = list("NHC" = 1, "UMID/OVID" = 2, "UM/OV"=3), 
+                             selected = 2),
+                textInput("id", label = "ID", value = ""),
+            ),
+            mainPanel(
+                htmlOutput("report"),
+                h3("Nitrogen"),
+                tableOutput("nitrogen")
+            )
+        )
     )
 )
 
 # Define server logic required to draw a histogram
 server <- function(input, output) {
     
+    ## Update
+    
     values <- reactiveValues()
     values[["DF"]]<-DF
     values[["samples"]]<-samples
@@ -60,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:"))
@@ -68,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()   
+            }
+                
         }
     })
     
@@ -199,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"]])
     })
 
@@ -296,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,{
@@ -431,6 +522,88 @@ server <- function(input, output) {
         }
     })
     
+    ## Visor
+    
+    output$report<-renderUI({
+        samples<-sqlFetch(dta, "samples")
+        if (input$nhc == 1){samples_sel<-samples %>% filter(OVID == input$id)}
+        if (input$nhc == 2){samples_sel<-samples %>% filter(OVID == input$id)}
+        if (input$nhc == 3){samples_sel<-samples %>% filter(samples == input$id)}
+        
+        print(input$id)
+        print(samples_sel)
+        
+        if (input$nhc == 3){
+            HTML(paste0(
+            "
+            <style>
+            table {
+              font-family: Arial, Helvetica, sans-serif;
+              border-collapse: collapse;
+              width: 100%;
+            }
+            
+            table td, table th {
+              border: 1px solid #ddd;
+              padding: 8px;
+            }
+            
+            table tr:nth-child(even){background-color: #f2f2f2;}
+            
+            table tr:hover {background-color: #ddd;}
+            
+            table th {
+              padding-top: 12px;
+              padding-bottom: 12px;
+              text-align: left;
+              background-color: #04AA6D;
+              color: white;
+            }
+            </style>
+            ",
+            "<h3>Muestra: ",input$id,"</h3>",
+            "<b>OVID</b>: ",samples_sel$OVID,"<br>",
+            "<b>Fecha</b>: ",samples_sel$IQ_date,"<br>",
+            "<b>Tipo de tejido: </b>",samples_sel$Tissue,"<br><br>",
+            "<b>AP: </b>",samples_sel$AP,"<br><br>",
+            "<b>Comments:</b>","<br>   ",samples_sel$Coments,"<br><br>",
+            
+            "<table style='width:auto;'>
+                <tg>
+                    <th><b>Hist</b></th>
+                    <th><b>RNA</b></th>
+                    <th><b>Slide</b></th>
+                    <th><b>Frag</b></th>
+                    <th><b>Disg</b></th>
+                </tr>
+                <tr>
+                    <td>",samples_sel$Hist_dic,"</td>
+                    <td>",samples_sel$RNA_dic,"</td>
+                    <td>",samples_sel$Slide_dic,"</td>
+                    <td>",samples_sel$Frag_vial,"</td>
+                    <td>",samples_sel$Disg_vial,"</td>
+            "
+            ))
+        }
+        #**AP**: `r samples_sel$AP`
+        
+        #**Macro**:
+         #   `r samples_sel$Macro`
+        
+        #**Despcripción**:
+        #    `r samples_sel$Description`
+        
+        #**Procesado**:
+        #    `r samples_sel$Process`
+    })
+    
+    output$nitrogen<-renderTable({
+        nitro<-sqlFetch(dta, "NITROGEN")
+        if (input$nhc == 3){nitro<-nitro %>% filter(CODIGO == input$id)}
+        else{nitro<-as.data.frame(matrix(ncol=0, nrow=0))}
+        nitro
+    })
+    
 }
 
 # Run the application 

sqlFunctions.R

@@ -66,19 +66,25 @@ sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL){
   if(sqlTables(conn) %>% filter(TABLE_NAME == "OVID") %>% nrow > 0){dbtype<-"OV"}
   
   if (dbtype == "OV"){
-    db<-c("dbcode"="OVID")
+    db<-c("dbcode"="OVID", "dbpref"="OVID")
   }
   if (dbtype == "UM"){
-    db<-c("dbcode"="UMID")
+    db<-c("dbcode"="UMID","dbpref"="UMID")
+  }
+  if (dbtype == "CC"){
+    db<-c("dbcode"="PATID", "dbpref"="CCID")
   }
   
   dbid<-sqlFetch(conn,db["dbcode"])
-  
   new.nhc<-nhcs[!nhcs %in% dbid$NHC] %>% unique()
+
   if(length(new.nhc) > 0){
+    if (nrow(dbid) == 0){next.num<-1}else{
     next.num<-gsub(db["dbcode"],"",dbid[,db["dbcode"]]) %>% as.numeric %>% max(na.rm=T)+1
+    }
+    print(next.num)
     last.num<-next.num+(length(new.nhc)-1)
-    newtab<-data.frame("NHC"=new.nhc, "ID"=sprintf("%s%04d",db["dbcode"],next.num:last.num)) %>% rename(!!db["dbcode"]:="ID")
+    newtab<-data.frame("NHC"=new.nhc, "ID"=sprintf("%s%04d",db["dbpref"],next.num:last.num)) %>% rename(!!db["dbcode"]:="ID")
     if(dbtype=="OV"){
       dbid<-rbind(dbid,newtab)
     }
@@ -87,6 +93,10 @@ sqlGenOVID<-function(conn=dta, nhcs=nhc.test, verb=T, sinc=F, dbtype=NULL){
       # dbid$Id<-as.numeric(rownames(dbid))
       dbid$NHC<-as.numeric(dbid$NHC)
     }
+    if (dbtype=="CC"){
+      dbid<-merge(dbid, newtab, all=T) %>% select(NHC,PATID) %>% arrange(PATID)
+      dbid$NHC<-as.numeric(dbid$NHC)
+    }
     rownames(dbid)<-as.character(1:nrow(dbid))
     dbid<-filter(dbid, NHC %in% new.nhc) %>% mutate(NHC=as.character(NHC))