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

Soporte para base de datos OVID.

Browse Source
This commit is contained in:
Costa
2022-03-04 14:56:19 +01:00
parent 5762efa5e4
commit 022a222ddf
1 changed files with 222 additions and 124 deletions
Download Patch File Download Diff File Expand all files Collapse all files
BDAccess/app.R
+111 -13
View File
@@ -2,7 +2,6 @@ library(shiny)
library(rhandsontable)
print(getwd())
print(file)
source("../sqlFunctions.R", encoding = "UTF-8")
DF<-data.frame("NHC"="","Samples"="")
@@ -28,7 +27,7 @@ ui <- fluidPage(
hr(),
fileInput(inputId = "file_query", label = "Plantilla", multiple = F),
actionButton("impNHC", "Importa NHC"),
actionButton("goButton", "Genera UMID"),
actionButton("goButton", "Genera CodiID"),
hr(),
actionButton("filltemplate", "Plantilla"),
hr(),
@@ -59,8 +58,17 @@ server <- function(input, output) {
values[["Excel"]]<-""
observeEvent(input$butdbtype, {
dta<<-odbcConnectAccess2007(access.file = file,
print(UMfile)
print(OVfile)
if (input$dbtype == "UM"){
dta<<-odbcConnectAccess2007(access.file = UMfile,
pwd = .rs.askForPassword("Enter password:"))
}
if (input$dbtype == "OV"){
dta<<-odbcConnectAccess2007(access.file = OVfile,
pwd = .rs.askForPassword("Enter password:"))
}
print(dta)
if (input$backup == T){
sqlBackUp()
@@ -109,7 +117,6 @@ server <- function(input, output) {
})
observe({
print(1)
if (!is.null(input$samples)) {
samples = hot_to_r(input$samples)
} else {
@@ -190,15 +197,21 @@ server <- function(input, output) {
})
observeEvent(input$goButton, {
print(dta)
sqlGenOVID(nhcs = values[["DF"]]$NHC, sinc=T)
sqlGenOVID(dta, nhcs = values[["DF"]]$NHC, sinc=T)
if (input$dbtype == "UM"){
values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "UMID"))
}
if (input$dbtype == "OV"){
values[["DF"]]<-merge(values[["DF"]], sqlFetch(dta, "OVID"))
}
print(values[["DF"]])
})
observeEvent(input$filltemplate,{
today=T
if (input$dbtype == "UM"){
upd.umid<-sqlFetch(dta, "UMID") %>% filter(NHC %in% values[["DF"]]$NHC)
## Generar código para las nuevas muestras
samples<-sqlFetch(dta, "MUESTRAS")
@@ -251,13 +264,41 @@ server <- function(input, output) {
values[["CLINICS"]]<-upd.clinics
values[["cnag"]]<-cnag.exp
values[["rna"]]<-rna.exp
}
if (input$dbtype == "OV"){
upd.umid<-sqlFetch(dta, "OVID") %>% filter(NHC %in% values[["DF"]]$NHC)
## Generar código para las nuevas muestras
samples<-sqlFetch(dta, "SAMPLES")
if(sum(grepl(paste0("OV",Sys.time() %>% format("%y")), samples$samples)) > 0){
next.samp<-gsub(paste0("OV",Sys.time() %>% format("%y")),"", samples$samples) %>% as.numeric %>% max(na.rm=T)+1
}else{
next.samp<-1
}
last.samp<-next.samp+(length(values[["DF"]]$NHC)-1)
new.samp<-sprintf("OV%s%02d",Sys.time() %>% format("%y"),next.samp:last.samp)
new.samp.df<-data.frame("NHC"=values[["DF"]]$NHC, "samples"=new.samp) %>% merge(sqlFetch(dta,"OVID"), all.x=T) %>% arrange(samples)
samples.exp<-merge(samples %>% slice(0), new.samp.df %>% select(-NHC), all=T) %>% select(colnames(samples)) %>% arrange(samples)
if (today==TRUE){
samples.exp$IQ_date<-format(Sys.Date(), "%d/%m/%y")
}
print(values[["rna"]] %>% sapply(class))
nhc.table<-values[["DF"]]
## Importar los datos clínicos de pacientes existentes y generar nueva entrada par los nuevos
upd.clinics<-sqlFetch(dta, "CLINICS")
umid.new<-sqlFetch(dta, "OVID") %>% filter(NHC %in% values[["DF"]]$NHC)
upd.clinics<-merge(umid.new,upd.clinics, all.x=T, by="OVID")
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 %>% mutate(across(lubridate::is.POSIXct, as.character))
values[["CLINICS"]]<-upd.clinics %>% mutate(across(lubridate::is.POSIXct, as.character))
}
})
observeEvent(input$synctemplate,{
if (input$dbtype == "UM"){
# conn=dta, filetemp="queryOV.xlsx", sinc.samples=F, sinc.clinics=F, dbtype=NULL
## Nuevas entradas en MUESTRAS
@@ -270,7 +311,6 @@ server <- function(input, output) {
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.")
}
@@ -301,7 +341,7 @@ server <- function(input, output) {
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()
clinics.new[,i]<-lubridate::parse_date_time(clinics.new[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date()
}
sqlSave(dta, clinics.new, tablename="CLINICOS", append = T, varTypes = varTypes, rownames = F)
print("Tabla CLINICOS sincronizada.")
@@ -314,7 +354,7 @@ server <- function(input, output) {
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()
cnag.sync[,i]<-lubridate::parse_date_time(cnag.sync[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date()
}
sqlSave(dta, cnag.sync, tablename="CNAG", append = T, varTypes = varTypes, rownames = F)
}
@@ -326,10 +366,68 @@ server <- function(input, output) {
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()
rna.sync[,i]<-lubridate::parse_date_time(rna.sync[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date()
}
sqlSave(dta, rna.sync, tablename="RNADNA", append = T, varTypes = varTypes, rownames = F)
}
}
if (input$dbtype == "OV"){
## Nuevas entradas en SAMPLES
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){
fechas<-colnames(upd.samples)[sqlFetch(dta, "SAMPLES") %>% sapply(lubridate::is.POSIXct)]
for (i in fechas){
upd.samples[,i]<-lubridate::parse_date_time(upd.samples[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date()
}
varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas
# upd.samples$TIPO<-as.character(upd.samples$TIPO)
# upd.samples$OBS<-as.character(upd.samples$OBS)
### !! Atención, esto cambia la base de datos:
sqlSave(dta, upd.samples, tablename="SAMPLES", append = T, varTypes = varTypes, rownames = F)
print("Tabla SAMPLES sincronizada.")
}
## Entradas modificadas en CLINICOS
upd.clinics<-values[["CLINICS"]]
umid.mod<-upd.clinics$OVID[upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))]
rnames<-sqlFetch(dta, "CLINICS") %>% filter(OVID %in% umid.mod) %>% rownames
clinics.mod<-upd.clinics %>% filter(OVID %in% umid.mod) %>% select(-NHC)
rownames(clinics.mod)<-rnames
### !! Atención, esto cambia la base de datos:
print(clinics.mod)
fechas<-colnames(clinics.mod)[sqlFetch(dta, "CLINICS") %>% sapply(lubridate::is.POSIXct)]
for (i in fechas){
clinics.mod[,i]<-lubridate::parse_date_time(clinics.mod[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date()
}
varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas
print(clinics.mod)
sqlUpdate(dta, clinics.mod,"CLINICS", index="OVID")
print("Tabla CLINICS modificada.")
## Nuevas entradas en CLINICOS
nsamples.clin<-sqlFetch(dta, "CLINICS") %>% nrow
umid.new<-upd.clinics$OVID[!upd.clinics$OVID %in% (sqlFetch(dta, "CLINICS") %>% pull(OVID))]
clinics.new<-upd.clinics %>% filter(OVID %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)[sqlFetch(dta, "CLINICS") %>% sapply(lubridate::is.POSIXct)]
for (i in fechas){
clinics.new[,i]<-lubridate::parse_date_time(clinics.new[,i], c("d/m/Y","d/m/y","Y-m-d")) %>% as.Date()
}
varTypes<-rep("Date",length(fechas))
names(varTypes)<-fechas
print(varTypes)
print(clinics.new)
sqlSave(dta, clinics.new, tablename="CLINICS", append = T, varTypes = varTypes, rownames = F)
print("Tabla CLINICS sincronizada.")
}
})
}