Skip to content

Commit

Permalink
fix for get_diver_data
Browse files Browse the repository at this point in the history
  • Loading branch information
@msberends
msberends committed Sep 12, 2024
1 parent c9c42a8 commit 999086d
Show file tree
Hide file tree
Showing 4 changed files with 38 additions and 24 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: certedb
Title: A Certe R Package for Connecting to Databases
Version: 1.12.0
Version: 1.12.1
Authors@R: c(
person(given = c("Matthijs", "S."),
family = "Berends",
Expand Down Expand Up @@ -44,5 +44,5 @@ Suggests:
License: GPL-2
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.3.1
RoxygenNote: 7.3.2
Config/testthat/edition: 2
25 changes: 15 additions & 10 deletions R/get_diver_data.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,7 @@
#' @param review_qry a [logical] to indicate whether the query must be reviewed first, defaults to `TRUE` in interactive mode and `FALSE` otherwise. This will always be `FALSE` in Quarto / R Markdown, since the output of [knitr::pandoc_to()] must be `NULL`.
#' @param antibiogram_type antibiotic transformation mode. Leave blank to strip antibiotic results from the data, `"sir"` to keep SIR values, `"mic"` to keep MIC values or `"disk"` to keep disk diffusion values. Values will be cleaned with [`as.sir()`][AMR::as.sir()], [`as.mic()`][AMR::as.mic()] or [`as.disk()`][AMR::as.disk()].
#' @param preset a preset to choose from [presets()]. Will be ignored if `diver_cbase` is set, even if it is set to `NULL`.
#' @param date_column column name of data set to query. Normally this should be set in a preset, but this argument can be used to override that.
#' @param distinct [logical] to apply [distinct()] to the resulting data set
#' @param auto_transform [logical] to apply [auto_transform()] to the resulting data set
#' @param snake_case [logical] to convert column names to [snake case](https://en.wikipedia.org/wiki/Snake_case), **only** when `auto_transform = TRUE`
Expand Down Expand Up @@ -87,6 +88,9 @@
#'
#' # USING DIVER INTEGRATOR LANGUAGE --------------------------------------
#'
#' # See the website for an overview of allowed functions:
#' # https://www.dimins.com/online-help/workbench_help/Content/ODBC/di-odbc-sql-reference.html
#'
#' # Use Diver Integrator functions within EVAL():
#' get_diver_data(2024, where = EVAL('regexp(value("MateriaalCode"),"^B")'))
#'
Expand All @@ -95,8 +99,6 @@
#' where = EVAL('rolling(12, value("OntvangstDatum"), date("2024/11/27"))')
#' )
#'
#' # See the website for an overview of allowed functions:
#' # https://www.dimins.com/online-help/workbench_help/Content/ODBC/di-odbc-sql-reference.html
#' }
get_diver_data <- function(date_range = this_year(),
where = NULL,
Expand All @@ -106,6 +108,7 @@ get_diver_data <- function(date_range = this_year(),
auto_transform = TRUE,
snake_case = TRUE,
preset = read_secret("db.preset_default"),
date_column = NULL,
diver_cbase = NULL,
diver_project = read_secret("db.diver_project"),
diver_dsn = if (diver_testserver == FALSE) read_secret("db.diver_dsn") else read_secret("db.diver_dsn_test"),
Expand All @@ -119,29 +122,30 @@ get_diver_data <- function(date_range = this_year(),
if (is_empty(preset)) {
preset <- NULL
}
date_column <- NULL
if (missing(diver_cbase)) {
if (is_empty(diver_cbase)) {
diver_cbase <- NULL
}
if (is.null(diver_cbase)) {
# get preset
preset <- get_preset(preset)
diver_cbase <- preset$cbase
date_column <- preset$date_col
if (is.null(date_column)) {
date_column <- preset$date_col
}
} else {
if (!is.null(preset)) {
msg("Ignoring `preset = \"", preset, "\"` since `diver_cbase` is set")
}
preset <- NULL
}
if (is_empty(diver_cbase)) {
diver_cbase <- ""
}
if (is_empty(date_column) && !is.null(date_range)) {
stop("'date_col' must be given in the preset if 'date_range' is set")
stop("if 'date_range' is set, 'date_column' must be set, or 'date_col' must be given in the preset", call. = FALSE)
}

if (isTRUE(in_background)) {
message("NOTE: use ...$get_result() to retrieve results when they are available.\n\n",
"If the call was:\n",
" data_123 <- get_diver_data(...)\n",
" data_123 <- get_diver_data(..., in_background = TRUE)\n",
"Then after a while retrieve results using:\n",
" data_123 <- data_123$get_result()")
out <- callr::r_bg(certedb::get_diver_data,
Expand All @@ -151,6 +155,7 @@ get_diver_data <- function(date_range = this_year(),
antibiogram_type = antibiogram_type,
distinct = distinct,
auto_transform = auto_transform,
date_column = date_column,
preset = preset,
diver_cbase = diver_cbase,
diver_project = diver_project,
Expand Down
25 changes: 15 additions & 10 deletions R/shiny.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -61,17 +61,17 @@ shiny_explore <- function(preset = read_secret("db.preset_default_shiny"),
selectInput("preset_select", "Preset", choices = presets()$preset, selected = preset),
h4("Ordergegevens"),
textInput("Ordernummer", "Ordernummer"),
dateRangeInput("datumbereik", "Ontvangst of -afnamedatum",
dateRangeInput("datumbereik", label = textOutput("date_col"),
start = as.Date(paste0(format(Sys.Date(), "%Y"), "-01-01")),
end = as.Date(paste0(format(Sys.Date(), "%Y"), "-12-31")),
language = "nl"),
textInput("BepalingCode", "Bepalingscode"),
textInput("Bepaling", "Bepalingsnaam (reguliere expressie)"),
textInput("BepalingCode", "BepalingCode"),
textInput("BepalingOmschrijving", "BepalingOmschrijving (reguliere expressie)"),
h4("Patient"),
textInput("PatientBSN", "BSN"),
textInput("PatientID", "Patientnummer"),
textInput("PatientNaam", "Naam (reguliere expressie)"),
textInput("PatientGeboortedatum", "Geboortedatum"),
textInput("PatientBSN", "PatientBSN"),
textInput("PatientID", "PatientID"),
textInput("PatientNaam", "PatientNaam (reguliere expressie)"),
textInput("PatientGeboortedatum", "PatientGeboortedatum"),
actionButton("zoek", "Zoeken", width = "31%"),
actionButton("sluit", "Sluiten", width = "25%"),
actionButton("kopie", "Syntax kopieren", width = "41%")
Expand All @@ -86,12 +86,16 @@ shiny_explore <- function(preset = read_secret("db.preset_default_shiny"),

server <- function(input, output, session) {

output$date_col <- renderText({
paste0(get_preset(input$preset_select)$date_col, " (gebaseerd op preset)")
})

data <- eventReactive(input$zoek, {
where_clauses <- vapply(FUN.VALUE = character(1),
names(input),
function(x) {
if (x %unlike% "^(data_table|datumbereik|preset_select|zoek|sluit|kopie)" && !is.null(input[[x]]) && !all(input[[x]] == "", na.rm = TRUE)) {
if (x %in% c("PatientNaam", "Bepaling")) {
if (x %in% c("PatientNaam", "BepalingOmschrijving")) {
paste0(x, " %like% \"", input[[x]], "\"")
# } else if (input[[x]] %like% "^[0-9]+$") {
# paste0(x, " == ", input[[x]])
Expand Down Expand Up @@ -133,8 +137,9 @@ shiny_explore <- function(preset = read_secret("db.preset_default_shiny"),
observeEvent(input$kopie, {
qry_text <- paste0("get_diver_data(date_range = c(\"", pkg_env$qry_shiny$date_range[1], "\", \"", pkg_env$qry_shiny$date_range[2], "\")",
ifelse(is.null(pkg_env$qry_shiny$where),
")",
paste0(",\n where = ", pkg_env$qry_shiny$where, ")")))
"",
paste0(",\n where = ", pkg_env$qry_shiny$where)),
",\n preset = \"", input$preset_select, "\")")
clipr::write_clip(qry_text)
rstudioapi::showDialog(title = "Gekopieerd",
message = paste0("Tekst gekopieerd naar klembord:\n\n", qry_text))
Expand Down
8 changes: 6 additions & 2 deletions man/get_diver_data.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 999086d

Please sign in to comment.