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

Añadir cancer de cólon.

Browse Source
This commit is contained in:
Costa
2022-03-17 17:15:54 +01:00
parent af5eee3a33
commit ffdf64d736
2 changed files with 92 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files
BDAccess/app.R
+77 -5
View File
@@ -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,7 +227,12 @@ 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"))
@@ -226,6 +240,9 @@ server <- function(input, output) {
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
+14 -4
View File
@@ -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))