Añadir cancer de cólon.

BDAccess/app.R

@@ -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,{

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))