From a85e19c1362979df98bf5d5820097e1aa7fb9c75 Mon Sep 17 00:00:00 2001 From: Peter Dutey-Magni Date: Sat, 13 May 2023 21:06:39 +0100 Subject: [PATCH] refactor all bridge_tables and add metrics tables #109 - remove bridge_encounter_therapy_overlap() - add bridge_episode_therapy_overlap() - add bridge_inpatient_episodes_date() - add bridge_drug_prescriptions_date() - add create_reporting_inpatient() - add create_reporting_med_prescribing() - begin rewriting Ramses.Rmd vignette (getting started) - change name of Postgres database --- .github/workflows/Postgres.yaml | 2 +- .github/workflows/R-CMD-check.yaml | 2 +- DESCRIPTION | 3 +- NAMESPACE | 6 +- R/bridge_and_metrics.R | 601 ++++++++++++++++++ R/database.R | 479 +------------- man/bridge_tables.Rd | 31 +- man/create_reporting_inpatient.Rd | 25 + man/create_reporting_med_prescribing.Rd | 27 + tests/testthat/test-bridge-metrics-Postgres.R | 534 ++++++++++++++++ tests/testthat/test-bridge-metrics-duckdb.R | 472 ++++++++++++++ tests/testthat/test-objects.R | 8 +- tests/testthat/test-warehousing-duckdb.R | 254 ++++---- tests/testthat/test-warehousing-postgres.R | 356 +++++------ vignettes/Ramses.Rmd | 354 +++++++---- 15 files changed, 2223 insertions(+), 931 deletions(-) create mode 100644 R/bridge_and_metrics.R create mode 100644 man/create_reporting_inpatient.Rd create mode 100644 man/create_reporting_med_prescribing.Rd create mode 100644 tests/testthat/test-bridge-metrics-Postgres.R create mode 100644 tests/testthat/test-bridge-metrics-duckdb.R diff --git a/.github/workflows/Postgres.yaml b/.github/workflows/Postgres.yaml index b9e01d5..94695cb 100644 --- a/.github/workflows/Postgres.yaml +++ b/.github/workflows/Postgres.yaml @@ -17,7 +17,7 @@ jobs: postgres: image: ${{ matrix.config.postgres_image }} env: - POSTGRES_DB: RamsesDB + POSTGRES_DB: RamsesDB_testing POSTGRES_USER: user POSTGRES_PASSWORD: password ports: diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 4c7dd0a..530dc12 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -21,7 +21,7 @@ jobs: postgres: image: postgres env: - POSTGRES_DB: RamsesDB + POSTGRES_DB: RamsesDB_testing POSTGRES_USER: user POSTGRES_PASSWORD: password ports: diff --git a/DESCRIPTION b/DESCRIPTION index 1d6ef1d..30d4f6a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -63,11 +63,12 @@ Suggests: Remotes: ramses-antibiotics/snomedizer RdMacros: Rdpack -RoxygenNote: 7.2.0 +RoxygenNote: 7.2.1 VignetteBuilder: knitr,rmarkdown Collate: 'Ramses-deprecated.R' 'Ramses-package.R' + 'bridge_and_metrics.R' 'objects.R' 'clinical_features.R' 'database.R' diff --git a/NAMESPACE b/NAMESPACE index 304c7ab..fd3c240 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,9 +8,11 @@ export(Patient.RamsesObject) export(TherapyEpisode) export(TherapyEpisode.DBIConnection) export(TherapyEpisode.MedicationRequest) -export(bridge_encounter_therapy_overlap) +export(bridge_drug_prescriptions_date) export(bridge_episode_prescription_initiation) export(bridge_episode_prescription_overlap) +export(bridge_episode_therapy_overlap) +export(bridge_inpatient_episodes_date) export(bridge_spell_therapy_overlap) export(bridge_tables) export(clinical_feature_interval) @@ -22,6 +24,8 @@ export(compute) export(compute_DDDs) export(connect_local_database) export(create_mock_database) +export(create_reporting_inpatient) +export(create_reporting_med_prescribing) export(create_therapy_episodes) export(download_icd10cm) export(get_ATC_name) diff --git a/R/bridge_and_metrics.R b/R/bridge_and_metrics.R new file mode 100644 index 0000000..9987453 --- /dev/null +++ b/R/bridge_and_metrics.R @@ -0,0 +1,601 @@ + + +#' Create database bridge tables +#' +#' @description Create or re-create bridge tables to facilitate linking prescribing +#' events with encounters or episodes of care. Bridge tables are used when computing +#' rates of prescribing per admission or per 1,000 bed-days. Examples are available +#' from the \link[Ramses]{Ramses} vignette: \code{browseVignettes("Ramses")}. +#' The resulting tables on the database are named \itemize{ +#' \item \code{bridge_episode_prescription_overlap} +#' \item \code{bridge_episode_prescription_initiation} +#' \item \code{bridge_episode_therapy_overlap} +#' \item \code{bridge_drug_prescriptions_date} +#' \item \code{bridge_inpatient_episodes_date}. +#' } +#' @param conn a database connection +#' @param overwrite if \code{TRUE}, the function will overwrite any existing +#' bridge table on the database. The default is \code{FALSE} +#' @param silent if \code{TRUE}, the progress bar will be hidden. The default is +#' \code{FALSE}. +#' @details +#' +#' Prescriptions with status \code{"entered-in-error"}, \code{"draft"}, +#' \code{"cancelled"}, or \code{"unknown"} are not taken into account. +#' \describe{ +#' \item{\code{bridge_tables()}}{Generates all bridge tables.} +#' \item{\code{bridge_episode_prescription_overlap()}}{Links prescriptions +#' with inpatient episodes when they were administered. The resulting +#' table is the natural join of \code{inpatient_episodes} and +#' \code{drug_prescriptions} based on matching patient identifiers +#' and a time overlap between prescriptions and inpatient episodes.} +#' \item{\code{bridge_episode_prescription_initiation()}}{Links prescriptions +#' with inpatient episodes when they were authored. The resulting table +#' differs from {\code{bridge_episode_prescription_overlap}}: it links prescriptions +#' to the episode referencing the clinical team who prescribed them, rather +#' that episodes during which the prescription was administered. The resulting +#' table is the natural join of \code{inpatient_episodes} and +#' \code{drug_prescriptions} based on matching patient identifiers +#' and the prescription authoring date being comprised between the episode +#' start and end dates.} +#' \item{\code{bridge_episode_therapy_overlap()}}{Links therapy episodes +#' with inpatient episodes during which they were administered. The resulting +#' table is the natural join of \code{inpatient_episodes} and +#' \code{drug_therapy_episodes} based on matching patient identifiers +#' and a time overlap between therapy episodes and hospital stays.} +#' \item{\code{bridge_drug_prescriptions_date()}}{Links prescriptions with +#' the date dimension: the resulting table has one row per date for each day +#' during which a prescription was active based on \code{prescription_start} +#' and \code{prescription_end} fields. Each \code{prescription_id} and \code{date} +#' combination is accompanied by the \emph{pro rata} day of therapy for that particular +#' date in the \code{DOT_prescribed} variable.} +#' \item{\code{bridge_inpatient_episodes_date()}}{Links inpatient episodes with +#' the date dimension: the resulting table has one row per date for each encounter +#' episode was taking place. Each \code{encounter_id}, \code{episode_number} and \code{date} +#' combination is accompanied by the \emph{pro rata} length of stay in the +#' \code{bed_days} variable.} +#' } +#' @return \code{TRUE} if tables were successfully created +#' @seealso \code{browseVignettes("Ramses")} +#' @name bridge_tables +#' @export +bridge_tables <- function(conn, + overwrite = FALSE, + silent = FALSE) { + + if (!DBI::dbExistsTable(conn, "drug_prescriptions") | + !DBI::dbExistsTable(conn, "drug_therapy_episodes")) { + stop("Table `drug_prescriptions` and `therapy_episodes` must exist.\n Please use `load_medications()` first.") + } + if (!DBI::dbExistsTable(conn, "inpatient_episodes")) { + stop("Table `inpatient_episodes` must exist.\nPlease use `load_inpatient_episodes()` first.") + } + + x <- vector() + if( !silent ) { + progress_bar <- progress::progress_bar$new( + format = " building bridge tables [:bar] :percent", + total = 5) + progress_bar$tick(0) + } + x[1] <- bridge_episode_prescription_overlap(conn, overwrite) + if( !silent ) progress_bar$tick() + x[2] <- bridge_episode_prescription_initiation(conn, overwrite) + if( !silent ) progress_bar$tick() + x[3] <- bridge_episode_therapy_overlap(conn, overwrite) + if( !silent ) progress_bar$tick() + x[4] <- bridge_drug_prescriptions_date(conn, overwrite) + if( !silent ) progress_bar$tick() + x[5] <- bridge_inpatient_episodes_date(conn, overwrite) + if( !silent ) progress_bar$tick() + + return(all(x)) +} + +#' @export +#' @name bridge_tables +bridge_episode_prescription_overlap <- function(conn, + overwrite = FALSE) { + stopifnot(is.logical(overwrite)) + if( !is(conn, "PqConnection") && !is(conn, "duckdb_connection") ) { + .throw_error_method_not_implemented("bridge_episode_prescription_overlap()", + class(conn)) + } + + if (!DBI::dbExistsTable(conn, "inpatient_episodes")) { + stop("Table `inpatient_episodes` must exist.\nPlease use `load_inpatient_episodes()` first.") + } + + if (!DBI::dbExistsTable(conn, "drug_prescriptions")) { + stop("Table `drug_prescriptions` must exist.\nPlease use `load_medications()` first.") + } + + tblz_episodes <- tbl(conn, "inpatient_episodes") + tblz_prescriptions <- tbl(conn, "drug_prescriptions") %>% + dplyr::filter( + .data$prescription_status %in% c("active", + "stopped", + "completed") + ) %>% + dplyr::select( + "patient_id", + "prescription_id", + "prescription_start", + "prescription_end" + ) + + tblz_bridge_episode_prescriptions_overlap <- tblz_episodes %>% + dplyr::inner_join(tblz_prescriptions, + by = "patient_id") %>% + dplyr::filter( + dplyr::between(.data$prescription_start, .data$episode_start, .data$episode_end) | + dplyr::between(.data$prescription_end, .data$episode_start, .data$episode_end) | + dplyr::between(.data$episode_start, .data$prescription_start, .data$prescription_end) + ) + + tblz_bridge_episode_prescriptions_overlap <- dplyr::mutate( + tblz_bridge_episode_prescriptions_overlap, + t_start = dplyr::sql("GREATEST(prescription_start::TIMESTAMP, episode_start::TIMESTAMP)"), + t_end = dplyr::sql("LEAST(prescription_end::TIMESTAMP, episode_end::TIMESTAMP)")) + + tblz_bridge_episode_prescriptions_overlap <- dplyr::select( + tblz_bridge_episode_prescriptions_overlap, + "patient_id", + "encounter_id", + "episode_number", + "prescription_id", + "t_start", + "t_end" + ) + + if (overwrite) { + .remove_db_tables(conn, "bridge_episode_prescription_overlap") + } + + dplyr::compute(tblz_bridge_episode_prescriptions_overlap, + name = "bridge_episode_prescription_overlap", + temporary = FALSE) + + return(TRUE) +} + +#' @export +#' @name bridge_tables +bridge_episode_prescription_initiation <- function(conn, + overwrite = FALSE) { + stopifnot(is.logical(overwrite)) + if( !is(conn, "PqConnection") && !is(conn, "duckdb_connection") ) { + .throw_error_method_not_implemented("bridge_episode_prescription_overlap()", + class(conn)) + } + + if (!DBI::dbExistsTable(conn, "inpatient_episodes")) { + stop("Table `inpatient_episodes` must exist.\nPlease use `load_inpatient_episodes()` first.") + } + + if (!DBI::dbExistsTable(conn, "drug_prescriptions")) { + stop("Table `drug_prescriptions` must exist.\nPlease use `load_medications()` first.") + } + + tblz_episodes <- tbl(conn, "inpatient_episodes") + tblz_prescriptions <- tbl(conn, "drug_prescriptions") %>% + dplyr::filter( + .data$prescription_status %in% c("active", + "stopped", + "completed") + ) %>% + dplyr::select( + "patient_id", + "prescription_id", + "prescription_start", + "prescription_end", + "authoring_date" + ) + + tblz_bridge_episode_prescription_initiation <- tblz_episodes %>% + dplyr::inner_join(tblz_prescriptions, by = "patient_id") %>% + dplyr::filter( + dplyr::between(.data$authoring_date, .data$episode_start, .data$episode_end) + ) %>% + dplyr::select( + "patient_id", + "encounter_id", + "episode_number", + "prescription_id" + ) + + if (overwrite) { + .remove_db_tables(conn, "bridge_episode_prescription_initiation") + } + + silence <- dplyr::compute(tblz_bridge_episode_prescription_initiation, + name = "bridge_episode_prescription_initiation", + temporary = FALSE) + + return(TRUE) +} + +#' @name bridge_tables +#' @export +bridge_episode_therapy_overlap <- function(conn, + overwrite = FALSE) { + stopifnot(is.logical(overwrite)) + if( !is(conn, "PqConnection") && !is(conn, "duckdb_connection") ) { + .throw_error_method_not_implemented("bridge_episode_therapy_overlap()", + class(conn)) + } + + if (!DBI::dbExistsTable(conn, "inpatient_episodes")) { + stop("Table `inpatient_episodes` must exist.\nPlease use `load_inpatient_episodes()` first.") + } + + if (!DBI::dbExistsTable(conn, "drug_therapy_episodes")) { + stop("Table `drug_therapy_episodes` must exist.\nPlease use `load_medications()` first.") + } + + tblz_encounters <- tbl(conn, "inpatient_episodes") %>% + dplyr::select("patient_id", + "encounter_id", + "episode_number", + "episode_start", + "episode_end") + tblz_therapies <- tbl(conn, "drug_therapy_episodes") + + tblz_bridge_episode_therapy_overlap <- tblz_encounters %>% + dplyr::inner_join(tblz_therapies, by = "patient_id") %>% + dplyr::filter( + dplyr::between(.data$therapy_start, .data$episode_start, .data$episode_end) | + dplyr::between(.data$therapy_end, .data$episode_start, .data$episode_end) | + dplyr::between(.data$episode_start, .data$therapy_start, .data$therapy_end) + ) %>% + dplyr::mutate( + t_start = dplyr::sql("GREATEST(therapy_start::TIMESTAMP, episode_start::TIMESTAMP)"), + t_end = dplyr::sql("LEAST(therapy_end::TIMESTAMP, episode_end::TIMESTAMP)") + ) %>% + dplyr::select( + "patient_id", + "encounter_id", + "episode_number", + "therapy_id", + "t_start", + "t_end" + ) + + if (overwrite) { + .remove_db_tables(conn, "bridge_episode_therapy_overlap") + } + + silence <- dplyr::compute(tblz_bridge_episode_therapy_overlap, + name = "bridge_episode_therapy_overlap", + temporary = FALSE) + return(TRUE) +} + + +#' @name bridge_tables +#' @export +bridge_inpatient_episodes_date <- function(conn, overwrite = FALSE) { + stopifnot(is.logical(overwrite)) + if( !is(conn, "PqConnection") && !is(conn, "duckdb_connection") ) { + .throw_error_method_not_implemented("bridge_episode_prescription_overlap()", + class(conn)) + } + + if (!DBI::dbExistsTable(conn, "inpatient_episodes")) { + stop("Table `inpatient_episodes` must exist.\nPlease use `load_inpatient_episodes()` first.") + } + + if (!DBI::dbExistsTable(conn, "drug_therapy_episodes")) { + stop("Table `drug_therapy_episodes` must exist.\nPlease use `load_medications()` first.") + } + + if (overwrite) { + .remove_db_tables(conn, "bridge_inpatient_episodes_date") + } + + ip_dates <- tbl(conn, "inpatient_episodes") %>% + .sql_generate_date_series("episode_start", "episode_end") %>% + dplyr::mutate( + bed_days = dplyr::sql( + "CASE WHEN episode_start::date = date THEN 3600.0*24.0 - EXTRACT(epoch from CAST(episode_start::TIMESTAMP as TIME)) + WHEN episode_end::date = date THEN EXTRACT(epoch FROM CAST(episode_end::TIMESTAMP as TIME)) + ELSE 3600*24 END / 3600.0 / 24.0 + ") + ) %>% + dplyr::select("patient_id", "encounter_id", "episode_number", "date", "bed_days") %>% + dplyr::compute( + name = "bridge_inpatient_episodes_date", + temporary = FALSE + ) + + return(TRUE) +} + +#' @name bridge_tables +#' @export +bridge_drug_prescriptions_date <- function(conn, overwrite = FALSE) { + stopifnot(is.logical(overwrite)) + if( !is(conn, "PqConnection") && !is(conn, "duckdb_connection") ) { + .throw_error_method_not_implemented("bridge_episode_prescription_overlap()", + class(conn)) + } + + if (!DBI::dbExistsTable(conn, "drug_prescriptions")) { + stop("Table `drug_prescriptions` must exist.\nPlease use `load_medications()` first.") + } + + if (!DBI::dbExistsTable(conn, "bridge_episode_prescription_overlap")) { + stop("Table `bridge_episode_prescription_overlap` must exist.") + } + + if (overwrite) { + .remove_db_tables(conn, "bridge_drug_prescriptions_date") + } + + DDD_enabled <- "DDD" %in% colnames(dplyr::tbl(conn, "drug_prescriptions")) + + rx_all <- dplyr::tbl(conn, "drug_prescriptions") %>% + dplyr::filter( + .data$prescription_status %in% c("active", + "stopped", + "completed") + ) %>% + .sql_generate_date_series("prescription_start", "prescription_end") %>% + dplyr::mutate( + DOT_prescribed_all = dplyr::sql( + "CASE WHEN prescription_start::date = date THEN 3600.0 * 24.0 - EXTRACT(epoch from CAST(prescription_start::TIMESTAMP as TIME)) + WHEN prescription_end::date = date THEN EXTRACT(epoch FROM CAST(prescription_end::TIMESTAMP as TIME)) + ELSE 3600*24 END / 3600.0 / 24.0 + ") + ) + + if (DDD_enabled) { + rx_all <- rx_all %>% + dplyr::mutate( + DDD_prescribed_all = .data$DDD * .data$DOT_prescribed_all + ) %>% + dplyr::select("patient_id", "prescription_id", "date", "DOT_prescribed_all", "DDD_prescribed_all") %>% + dplyr::compute() + } else { + rx_all <- rx_all %>% + dplyr::select("patient_id", "prescription_id", "date", "DOT_prescribed") %>% + dplyr::compute() + } + + rx_ip_only <- dplyr::tbl(conn, "bridge_episode_prescription_overlap") %>% + .sql_generate_date_series("t_start", "t_end") %>% + dplyr::mutate( + DOT_prescribed_IP_only = dplyr::sql( + "CASE WHEN t_start::date = date THEN 3600.0 * 24.0 - EXTRACT(epoch from CAST(t_start::TIMESTAMP as TIME)) + WHEN t_end::date = date THEN EXTRACT(epoch FROM CAST(t_end::TIMESTAMP as TIME)) + ELSE 3600*24 END / 3600.0 / 24.0 + ") + ) + + if (DDD_enabled) { + rx_DDDs <- dplyr::tbl(conn, "drug_prescriptions") %>% + dplyr::select("prescription_id", "DDD") + + rx_ip_only <- rx_ip_only %>% + dplyr::left_join(rx_DDDs, by = "prescription_id") %>% + dplyr::mutate(DDD_prescribed_IP_only = .data$DOT_prescribed_IP_only * .data$DDD) %>% + dplyr::select( + "patient_id", + "prescription_id", + "date", + "DOT_prescribed_IP_only", + "DDD_prescribed_IP_only" + ) %>% + dplyr::compute() + + } else { + rx_ip_only <- rx_ip_only %>% + dplyr::select( + "patient_id", + "prescription_id", + "date", + "DOT_prescribed_IP_only" + ) %>% + dplyr::compute() + } + + rx_final <- dplyr::full_join( + rx_all, + rx_ip_only, + by = c("patient_id", + "prescription_id", + "date") + ) %>% + dplyr::compute( + name = "bridge_drug_prescriptions_date", + temporary = FALSE + ) + + return(TRUE) +} + + +#' Add demographics to a remote table with a "patient_id" key +#' +#' @param x a remote `tbl` object +#' +#' @return a remote `tbl` object enriched with any variables available from the +#' `patients` table out of: `date_of_birth`, `sex`, `ethnic_category_UK`, if it +#' exists. Otherwise, return `x` untransformed. +#' @noRd +.tbl_add_demographics <- function(x) { + # Verify if sex, dob and ethnicity are available. If they are, add them to the table + + if (!("patient_id" %in% colnames(x))) { + stop("`x` does not contain a `patient_id` field.") + } + + if (DBI::dbExistsTable(x$src$con, "patients")) { + x <- dplyr::compute(x) + pt_demog <- dplyr::tbl(x$src$con, "patients") + + demog_selection <- character(0) + if ("date_of_birth" %in% colnames(pt_demog)) demog_selection <- c(demog_selection, "date_of_birth") + if ("sex" %in% colnames(pt_demog)) demog_selection <- c(demog_selection, "sex") + if ("ethnic_category_UK" %in% colnames(pt_demog)) demog_selection <- c(demog_selection, "ethnic_category_UK") + + pt_demog <- dplyr::select(pt_demog, "patient_id", dplyr::all_of(demog_selection)) + + x <- dplyr::left_join( + x, + pt_demog, + by = "patient_id" + ) + } + + x +} + + +#' Build a reporting hypercube for inpatient activity +#' +#' @description Create or overwrite table \code{`hypercube_inpatient`} which reports +#' on prescribing during inpatient encounters. +#' +#' @param conn a database connection +#' +#' @details This function may be used after loading records into the Ramses database +#' to facilitate reporting on inpatient activity. +#' +#' DIMENSIONs +#' The following dimensions are built, if available from the Ramses database +#' +#' +#' @return a object of \code{`tbl_sql`} connected to the \code{reporting_inpatient_length_of_stay} table +#' @export +create_reporting_inpatient <- function(conn) { + + if (!DBI::dbExistsTable(conn, "inpatient_episodes")) { + stop("Table `inpatient_episodes` must exist.\nPlease use `load_inpatient_episodes()` first.") + } + + if ( + !DBI::dbExistsTable(conn, "bridge_episode_prescription_overlap") | + !DBI::dbExistsTable(conn, "bridge_drug_prescriptions_date") | + !DBI::dbExistsTable(conn, "bridge_inpatient_episodes_date") + ) { + stop("Bridge tables must exist. Please refer to ?bridge_tables for help") + } + + .remove_db_tables(conn, "metrics_inpatient") + + cube_dim_ip <- c( + "patient_id", + "encounter_id", + "episode_number", + "main_specialty_code", + "admission_method" + ) + + ip_expanded <- dplyr::tbl(conn, "inpatient_episodes") %>% + dplyr::select(dplyr::all_of(cube_dim_ip)) %>% + dplyr::left_join( + dplyr::tbl(conn, "bridge_inpatient_episodes_date"), + by = c("patient_id", "encounter_id", "episode_number") + ) %>% + dplyr::mutate( + admission_method_name = dplyr::case_when( + admission_method == "1" ~ "Elective", + admission_method == "2" ~ "Emergency", + admission_method == "3" ~ "Transfer/Other" + ) + ) %>% + .tbl_add_demographics() + + age_enabled <- "date_of_birth" %in% colnames(ip_expanded) + + if (age_enabled) { + ip_expanded <- ip_expanded %>% + dplyr::mutate( + age = dplyr::sql("date_part('year', age(date, date_of_birth))") + ) %>% + dplyr::select(-"date_of_birth") + } + + ip_expanded <- ip_expanded %>% + dplyr::compute( + name = "metrics_inpatient", + temporary = FALSE + ) + + ip_expanded +} + + +#' Create prescribing reporting table +#' +#' @param conn a database connection +#' @details +#' #' METRICS +#' +#' \itemize{ +#' \item{DOT_prescribed: } +#' \item{DOT_administered: } IF AVAILABLE +#' \item{DDD_prescribed: } IF AVAILABLE +#' \item{DDD_administered: } IF AVAILABLE +#' } +#' @return a object of \code{`tbl_sql`} connected to the \code{metrics_prescribing} table +#' @export +create_reporting_med_prescribing <- function(conn) { + + if (!DBI::dbExistsTable(conn, "drug_prescriptions")) { + stop("Table `drug_prescriptions` must exist.\n Please use `load_medications()` first.") + } + + if ( + !DBI::dbExistsTable(conn, "bridge_drug_prescriptions_date") + ) { + stop("Bridge tables must exist. Please refer to ?bridge_tables for help") + } + + .remove_db_tables(conn, "metrics_prescribing") + + DDD_enabled <- "DDD" %in% colnames(dplyr::tbl(conn, "drug_prescriptions")) + + dim_cube_rx <- c( + "patient_id", + "prescription_id", + "antiinfective_type", + "prescription_context", + "drug_code", + "drug_group", + "drug_name", + "drug_display_name", + "ATC_code", + "ATC_route" + ) + + rx_data <- dplyr::tbl(conn, "drug_prescriptions") %>% + dplyr::select( + dplyr::all_of(dim_cube_rx) + ) %>% + dplyr::mutate( + parenteral = dplyr::if_else(ATC_route == "P", 1, 0) + ) %>% + dplyr::inner_join( + dplyr::tbl(conn, "bridge_drug_prescriptions_date"), + by = c("patient_id", "prescription_id") + ) %>% + .tbl_add_demographics() + + if ( "date_of_birth" %in% colnames(rx_data) ) { + rx_data <- rx_data %>% + dplyr::mutate( + age = dplyr::sql("date_part('year', age(date, date_of_birth))") + ) %>% + dplyr::select(-"date_of_birth") + } + + rx_data <- rx_data %>% + dplyr::compute( + name = "metrics_prescribing", + temporary = FALSE + ) + + rx_data +} diff --git a/R/database.R b/R/database.R index 1c0870d..e3d6ce1 100644 --- a/R/database.R +++ b/R/database.R @@ -1362,11 +1362,11 @@ create_mock_database <- function(file, #' Interface for SQL generate_series() function #' -#' @param x a `tbl_sql` object (remote table) +#' @param x a \code{tbl_sql} object (remote table) #' @param start_dt character string of name of a timestamp or date field #' @param end_dt character string of name of a timestamp or date field #' -#' @return +#' @return \code{x} with an additional variate \code{date} #' @noRd .sql_generate_date_series <- function(x, start_dt, end_dt) { stopifnot(is.character(start_dt) & length(start_dt) == 1) @@ -1376,326 +1376,34 @@ create_mock_database <- function(file, end_dt <- dbplyr::sql_quote(end_dt, '"') if (is(x$src$con, "duckdb_connection")) { - dplyr::mutate( + tbl_expanded <- dplyr::mutate( x, date = dplyr::sql(paste0("unlist(generate_series(", start_dt, "::DATE, ", end_dt, "::DATE, INTERVAL '1 day'))::DATE")) ) } else if (is(x$src$con, "PqConnection")) { - dplyr::mutate( + tbl_expanded <- dplyr::mutate( x, date = dplyr::sql(paste0("generate_series(", start_dt, "::DATE, ", end_dt, "::DATE, INTERVAL '1 day')::DATE")) ) } else { .throw_error_method_not_implemented(".sql_generate_date_series") } -} - - -#' Create database bridge tables -#' -#' @description Create or re-create bridge tables to facilitate linking prescribing -#' events with encounters or episodes of care. Bridge tables are used when computing -#' rates of prescribing per admission or per 1,000 bed-days. Examples are available -#' from the \link[Ramses]{Ramses} vignette: \code{browseVignettes("Ramses")}. -#' The resulting tables on the database are named \itemize{ -#' \item \code{bridge_episode_prescription_overlap} -#' \item \code{bridge_episode_prescription_initiation} -#' \item \code{bridge_encounter_therapy_overlap}. -#' } -#' @param conn a database connection -#' @param overwrite if \code{TRUE}, the function will overwrite any existing -#' bridge table on the database. The default is \code{FALSE} -#' @param silent if \code{TRUE}, the progress bar will be hidden. The default is -#' \code{FALSE}. -#' @details -#' -#' Prescriptions with status \code{"entered-in-error"}, \code{"draft"}, -#' \code{"cancelled"}, or \code{"unknown"} are not taken into account. -#' \describe{ -#' \item{\code{bridge_tables()}}{Generates all bridge tables.} -#' \item{\code{bridge_episode_prescription_overlap()}}{Links prescriptions -#' with inpatient episodes when they were administered. The resulting -#' table is the natural join of \code{inpatient_episodes} and -#' \code{drug_prescriptions} based on matching patient identifiers -#' and a time overlap between prescriptions and inpatient episodes.} -#' \item{\code{bridge_episode_prescription_initiation()}}{Links prescriptions -#' with inpatient episodes when they were authored. The resulting table -#' differs from {\code{bridge_episode_prescription_overlap}}: it links prescriptions -#' to the episode referencing the clinical team who prescribed them, rather -#' that episodes during which the prescription was administered. The resulting -#' table is the natural join of \code{inpatient_episodes} and -#' \code{drug_prescriptions} based on matching patient identifiers -#' and the prescription authoring date being comprised between the episode -#' start and end dates.} -#' \item{\code{bridge_encounter_therapy_overlap()}}{Links therapy episodes -#' with inpatient encounters during which they were administered. The resulting -#' table is the natural join of \code{inpatient_episodes} and -#' \code{drug_therapy_episodes} based on matching patient identifiers -#' and a time overlap between therapy episodes and hospital stays.} -#' } -#' @return \code{TRUE} if tables were successfully created -#' @seealso \code{browseVignettes("Ramses")} -#' @name bridge_tables -#' @export -bridge_tables <- function(conn, - overwrite = FALSE, - silent = FALSE) { - x <- vector() - if( !silent ) { - progress_bar <- progress::progress_bar$new( - format = " building bridge tables [:bar] :percent", - total = 3) - progress_bar$tick(0) - } - x[1] <- bridge_episode_prescription_overlap(conn, overwrite) - if( !silent ) progress_bar$tick() - x[2] <- bridge_episode_prescription_initiation(conn, overwrite) - if( !silent ) progress_bar$tick() - x[3] <- bridge_encounter_therapy_overlap(conn, overwrite) - if( !silent ) progress_bar$tick() - - return(all(x)) -} - -#' @export -#' @name bridge_tables -bridge_episode_prescription_overlap <- function(conn, - overwrite = FALSE) { - stopifnot(is.logical(overwrite)) - stopifnot(is(conn, "duckdb_connection") || is(conn, "PqConnection")) - - tblz_episodes <- tbl(conn, "inpatient_episodes") - tblz_prescriptions <- tbl(conn, "drug_prescriptions") %>% - dplyr::filter( - !.data$prescription_status %in% c("entered-in-error", - "draft", - "cancelled", - "unknown") - ) %>% - dplyr::select( - tidyselect::all_of(c( - "patient_id", - "prescription_id", - "prescription_start", - "prescription_end", - "antiinfective_type" - )), - tidyselect::any_of("DDD") - ) - DDD_present <- "DDD" %in% colnames(tblz_prescriptions) - - tblz_bridge_episode_prescriptions_overlap <- tblz_episodes %>% - dplyr::inner_join(tblz_prescriptions, - by = "patient_id") %>% - dplyr::filter( - dplyr::between(.data$prescription_start, .data$episode_start, .data$episode_end) | - dplyr::between(.data$prescription_end, .data$episode_start, .data$episode_end) | - dplyr::between(.data$episode_start, .data$prescription_start, .data$prescription_end) - ) - if( is(conn, "PqConnection") || is(conn, "duckdb_connection") ) { - tblz_bridge_episode_prescriptions_overlap <- dplyr::mutate( - tblz_bridge_episode_prescriptions_overlap, - t_start = dplyr::sql("GREATEST(prescription_start::TIMESTAMP, episode_start::TIMESTAMP)"), - t_end = dplyr::sql("LEAST(prescription_end::TIMESTAMP, episode_end::TIMESTAMP)")) %>% - dplyr::mutate( - DOT_prescribed = dplyr::sql("EXTRACT(EPOCH FROM (t_end - t_start)) / ( 3600.0 * 24.0 )"), - DDD_prescribed = if ( DDD_present ) { - dplyr::sql( - "EXTRACT(EPOCH FROM (t_end - t_start)) / ( 3600.0 * 24.0 ) * \"DDD\"" - ) - } else { - NULL - } - ) - - } else { - .throw_error_method_not_implemented("bridge_episode_prescription_overlap()", - class(conn)) - } - tblz_bridge_episode_prescriptions_overlap <- dplyr::select( - tblz_bridge_episode_prescriptions_overlap, - "patient_id", - "encounter_id", - "episode_number", - "prescription_id", - "antiinfective_type", - "t_start", - "t_end", - "DOT_prescribed", - if(DDD_present) "DDD_prescribed" else NULL + tbl_expanded <- dplyr::mutate( + tbl_expanded, + date_weight = dplyr::sql(paste0( + "CASE WHEN ", start_dt, "::date = date ", + "THEN 3600.0*24.0 - EXTRACT(epoch from CAST(", start_dt, "::TIMESTAMP as TIME))", + "WHEN ", end_dt, "::date = date ", + "THEN EXTRACT(epoch FROM CAST(", end_dt,"::TIMESTAMP as TIME)) ", + "ELSE 3600*24 END / 3600.0 / 24.0" + )) ) - if (overwrite) { - if(DBI::dbExistsTable(conn, "bridge_episode_prescription_overlap")) { - DBI::dbRemoveTable(conn, "bridge_episode_prescription_overlap") - } - } - - dplyr::compute(tblz_bridge_episode_prescriptions_overlap, - name = "bridge_episode_prescription_overlap", - temporary = FALSE) - - return(TRUE) + tbl_expanded } -#' @export -#' @name bridge_tables -bridge_episode_prescription_initiation <- function(conn, - overwrite = FALSE) { - - stopifnot(is.logical(overwrite)) - stopifnot(is(conn, "duckdb_connection") || is(conn, "PqConnection")) - - tblz_episodes <- tbl(conn, "inpatient_episodes") - tblz_prescriptions <- tbl(conn, "drug_prescriptions") %>% - dplyr::filter( - !.data$prescription_status %in% c("entered-in-error", - "draft", - "cancelled", - "unknown") - ) %>% - dplyr::select( - tidyselect::all_of(c( - "patient_id", - "prescription_id", - "antiinfective_type", - "prescription_start", - "prescription_end", - "authoring_date" - )), - tidyselect::any_of("DDD") - ) - DDD_present <- "DDD" %in% colnames(tblz_prescriptions) - - tblz_bridge_episode_prescription_initiation <- tblz_episodes %>% - dplyr::inner_join(tblz_prescriptions, - by = "patient_id") %>% - dplyr::filter( - dplyr::between(.data$authoring_date, .data$episode_start, .data$episode_end) - ) - - if( is(conn, "PqConnection") || is(conn, "duckdb_connection") ) { - tblz_bridge_episode_prescription_initiation <- dplyr::mutate( - tblz_bridge_episode_prescription_initiation, - DOT_prescribed = dplyr::sql( - "EXTRACT(EPOCH FROM ( - prescription_end::TIMESTAMP - - prescription_start::TIMESTAMP )) - / ( 3600.0 * 24.0 )" - ) - ) - - if ( DDD_present ) { - tblz_bridge_episode_prescription_initiation <- dplyr::mutate( - tblz_bridge_episode_prescription_initiation, - DDD_prescribed = dplyr::sql( - "EXTRACT(EPOCH FROM ( - prescription_end::TIMESTAMP - - prescription_start::TIMESTAMP )) - / ( 3600.0 * 24.0 ) * \"DDD\"") - ) - } - - } else { - .throw_error_method_not_implemented("bridge_episode_prescription_initiation()", - class(conn)) - } - - if ( DDD_present ) { - tblz_bridge_episode_prescription_initiation <- dplyr::select( - tblz_bridge_episode_prescription_initiation, - "patient_id", - "encounter_id", - "episode_number", - "prescription_id", - "antiinfective_type", - "DOT_prescribed", - "DDD_prescribed" - ) - } else { - tblz_bridge_episode_prescription_initiation <- dplyr::select( - tblz_bridge_episode_prescription_initiation, - "patient_id", - "encounter_id", - "episode_number", - "prescription_id", - "antiinfective_type", - "DOT_prescribed" - ) - } - - if (overwrite) { - if(DBI::dbExistsTable(conn, "bridge_episode_prescription_initiation")) { - DBI::dbRemoveTable(conn, "bridge_episode_prescription_initiation") - } - } - - silence <- dplyr::compute(tblz_bridge_episode_prescription_initiation, - name = "bridge_episode_prescription_initiation", - temporary = FALSE) - - return(TRUE) -} - -#' @name bridge_tables -#' @export -bridge_encounter_therapy_overlap <- function(conn, - overwrite = FALSE) { - stopifnot(is.logical(overwrite)) - stopifnot(is(conn, "duckdb_connection") || is(conn, "PqConnection")) - - tblz_encounters <- tbl(conn, "inpatient_episodes") %>% - dplyr::distinct(.data$patient_id, - .data$encounter_id, - .data$admission_date, - .data$discharge_date) - tblz_therapies <- tbl(conn, "drug_therapy_episodes") - - tblz_bridge_encounter_therapy_overlap <- tblz_encounters %>% - dplyr::inner_join(tblz_therapies, by = "patient_id") %>% - dplyr::filter( - dplyr::between(.data$therapy_start, .data$admission_date, .data$discharge_date) | - dplyr::between(.data$therapy_end, .data$admission_date, .data$discharge_date) | - dplyr::between(.data$admission_date, .data$therapy_start, .data$therapy_end) - ) - - if( is(conn, "PqConnection") || is(conn, "duckdb_connection") ) { - tblz_bridge_encounter_therapy_overlap <- dplyr::mutate( - tblz_bridge_encounter_therapy_overlap, - LOT = dplyr::sql( - "EXTRACT(EPOCH FROM ( - LEAST(therapy_end::TIMESTAMP, discharge_date::TIMESTAMP) - - GREATEST(therapy_start::TIMESTAMP, admission_date::TIMESTAMP) )) - / ( 3600.0 * 24.0 )" - ) - ) - } else { - .throw_error_method_not_implemented("bridge_encounter_therapy_overlap()", - class(conn)) - } - - tblz_bridge_encounter_therapy_overlap <- dplyr::select( - tblz_bridge_encounter_therapy_overlap, - "patient_id", - "encounter_id", - "therapy_id", - "antiinfective_type", - "LOT" - ) - - if (overwrite) { - if(DBI::dbExistsTable(conn, "bridge_encounter_therapy_overlap")) { - DBI::dbRemoveTable(conn, "bridge_encounter_therapy_overlap") - } - } - - silence <- dplyr::compute(tblz_bridge_encounter_therapy_overlap, - name = "bridge_encounter_therapy_overlap", - temporary = FALSE) - return(TRUE) -} #' Compute episode bed days in inpatient_episodes table #' @@ -1724,162 +1432,3 @@ bridge_encounter_therapy_overlap <- function(conn, / ( 24.0 * 3600.0 );" ) } - - -#' Add demographics to a remote table with a "patient_id" key -#' -#' @param x a remote `tbl` object -#' -#' @return a remote `tbl` object enriched with any variables available from the -#' `patients` table out of: `date_of_birth`, `sex`, `ethnic_category_UK`, if it -#' exists. Otherwise, return `x` untransformed. -#' @noRd -.tbl_add_demographics <- function(x) { - # Verify if sex, dob and ethnicity are available. If they are, add them to the table - - if (!("patient_id" %in% colnames(x))) { - stop("`x` does not contain a `patient_id` field.") - } - - if (DBI::dbExistsTable(x$src$con, "patients")) { - x <- dplyr::compute(x) - pt_demog <- dplyr::tbl(x$src$con, "patients") - - demog_selection <- character(0) - if ("date_of_birth" %in% colnames(pt_demog)) demog_selection <- c(demog_selection, "date_of_birth") - if ("sex" %in% colnames(pt_demog)) demog_selection <- c(demog_selection, "sex") - if ("ethnic_category_UK" %in% colnames(pt_demog)) demog_selection <- c(demog_selection, "ethnic_category_UK") - - pt_demog <- dplyr::select(pt_demog, "patient_id", dplyr::all_of(demog_selection)) - - x <- dplyr::left_join( - x, - pt_demog, - by = "patient_id" - ) - } - - x -} - - -create_metric_tbl_1 <- function(conn) { - - message("DOTs include active, stopped and completed inpatient prescriptions only") - # Set grouping set IDs - olap_dimensions <- c( - "drug_code" - ) - - rx_expanded <- dplyr::tbl(conn, "drug_prescriptions") %>% - dplyr::filter( - .data$prescription_status %in% c("active", - "stopped", - "completed") & - .data$prescription_context == "inpatient" - ) %>% - dplyr::select(!!c("prescription_id", - "prescription_start", - "prescription_end", - olap_dimensions)) - - rx_expanded <- tbl(conn, "bridge_episode_prescription_overlap") %>% - dplyr::inner_join(rx_expanded, by = c("prescription_id")) %>% - dplyr::left_join( - dplyr::select( - dplyr::tbl(conn, "inpatient_episodes"), - "patient_id", "encounter_id", "episode_number", "main_specialty_code", "admission_method" - ), - by = c("patient_id", "encounter_id", "episode_number") - ) %>% - .tbl_add_demographics() - - age_enabled <- "date_of_birth" %in% colnames(rx_expanded) - sex_enabled <- "sex" %in% colnames(rx_expanded) - ethnic_enabled <- "ethnic_category_UK" %in% colnames(rx_expanded) - - olap_dimensions <- c(olap_dimensions, "antiinfective_type", "admission_method", "main_specialty_code") - if (age_enabled) olap_dimensions <- c(olap_dimensions, "age") - if (sex_enabled) olap_dimensions <- c(olap_dimensions, "sex") - if (ethnic_enabled) olap_dimensions <- c(olap_dimensions, "ethnic_category_UK") - - if (is(conn, "duckdb_connection")) { - rx_expanded <- rx_expanded %>% - dplyr::mutate( - date = dplyr::sql("unlist(generate_series(start_dt, end_dt, interval '1 day'))::date") - ) - } else if (is(conn, "PqConnection")) { - rx_expanded <- rx_expanded %>% - dplyr::mutate( - date = dplyr::sql("generate_series(start_dt, end_dt, interval '1 day')::date") - ) - } - if (age_enabled) { - rx_expanded <- rx_expanded %>% - dplyr::mutate( - age = dplyr::sql("date_part('year', age(date, date_of_birth))") - ) %>% - dplyr::select(-"date_of_birth") - } - - rx_expanded <- rx_expanded %>% - dplyr::mutate( - dot_prescribed = dplyr::sql( - "CASE WHEN start_dt::date = date THEN 3600.0*24.0 - EXTRACT(epoch from CAST(start_dt::TIMESTAMP as TIME)) - WHEN end_dt::date = date THEN EXTRACT(epoch FROM CAST(end_dt::TIMESTAMP as TIME)) - ELSE 3600*24 END / 3600.0 / 24.0 - ") - ) %>% - dplyr::distinct(!!!dplyr::syms(c("prescription_id", "date", "dot_prescribed", olap_dimensions))) %>% - dplyr::compute() - - - ip_expanded <- tbl(conn, "inpatient_episodes") %>% - dplyr::select("episode_start", "episode_end", "main_specialty_code", "admission_method") - - if (is(conn, "duckdb_connection")) { - ip_expanded <- ip_expanded %>% - dplyr::mutate( - date = dplyr::sql("unlist(generate_series(episode_start, episode_end, interval '1 day'))::date") - ) - } else if (is(conn, "PqConnection")) { - ip_expanded <- ip_expanded %>% - dplyr::mutate( - date = dplyr::sql("generate_series(episode_start, episode_end, interval '1 day')::date") - ) - } - - ip_expanded <- ip_expanded%>% - dplyr::mutate( - bed_days = dplyr::sql( - "CASE WHEN episode_start::date = date THEN 3600.0*24.0 - EXTRACT(epoch from CAST(episode_start::TIMESTAMP as TIME)) - WHEN episode_end::date = date THEN EXTRACT(epoch FROM CAST(episode_end::TIMESTAMP as TIME)) - ELSE 3600*24 END / 3600.0 / 24.0 - ") - ) %>% - dplyr::select("date", "bed_days", "main_specialty_code", "admission_method") %>% - dplyr::compute() - - olap_dimensions <- c(olap_dimensions, "date") - - final_dt <- dplyr::full_join( - ip_expanded, - rx_expanded, - by = c("date", "main_specialty_code", "admission_method") - ) %>% - dplyr::compute() - - x <- DBI::dbGetQuery( - conn = conn, - statement = paste( - "SELECT 'inpatient_dot_totals' AS metric,", - paste(olap_dimensions, collapse = ", "), ", ", - "sum(dot_prescribed) as dot_prescribed,", - "sum(bed_days) as bed_days", - "FROM", dbplyr::remote_name(final_dt), - "GROUP BY CUBE (", paste(c(olap_dimensions), collapse = ", "), ");" - ) - ) - - x -} \ No newline at end of file diff --git a/man/bridge_tables.Rd b/man/bridge_tables.Rd index d36e3f3..b2c847a 100644 --- a/man/bridge_tables.Rd +++ b/man/bridge_tables.Rd @@ -1,10 +1,12 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/database.R +% Please edit documentation in R/bridge_and_metrics.R \name{bridge_tables} \alias{bridge_tables} \alias{bridge_episode_prescription_overlap} \alias{bridge_episode_prescription_initiation} -\alias{bridge_encounter_therapy_overlap} +\alias{bridge_episode_therapy_overlap} +\alias{bridge_inpatient_episodes_date} +\alias{bridge_drug_prescriptions_date} \title{Create database bridge tables} \usage{ bridge_tables(conn, overwrite = FALSE, silent = FALSE) @@ -13,7 +15,11 @@ bridge_episode_prescription_overlap(conn, overwrite = FALSE) bridge_episode_prescription_initiation(conn, overwrite = FALSE) -bridge_encounter_therapy_overlap(conn, overwrite = FALSE) +bridge_episode_therapy_overlap(conn, overwrite = FALSE) + +bridge_inpatient_episodes_date(conn, overwrite = FALSE) + +bridge_drug_prescriptions_date(conn, overwrite = FALSE) } \arguments{ \item{conn}{a database connection} @@ -35,7 +41,9 @@ from the \link[Ramses]{Ramses} vignette: \code{browseVignettes("Ramses")}. The resulting tables on the database are named \itemize{ \item \code{bridge_episode_prescription_overlap} \item \code{bridge_episode_prescription_initiation} - \item \code{bridge_encounter_therapy_overlap}. + \item \code{bridge_episode_therapy_overlap} + \item \code{bridge_drug_prescriptions_date} + \item \code{bridge_inpatient_episodes_date}. } } \details{ @@ -57,11 +65,22 @@ Prescriptions with status \code{"entered-in-error"}, \code{"draft"}, \code{drug_prescriptions} based on matching patient identifiers and the prescription authoring date being comprised between the episode start and end dates.} - \item{\code{bridge_encounter_therapy_overlap()}}{Links therapy episodes - with inpatient encounters during which they were administered. The resulting + \item{\code{bridge_episode_therapy_overlap()}}{Links therapy episodes + with inpatient episodes during which they were administered. The resulting table is the natural join of \code{inpatient_episodes} and \code{drug_therapy_episodes} based on matching patient identifiers and a time overlap between therapy episodes and hospital stays.} + \item{\code{bridge_drug_prescriptions_date()}}{Links prescriptions with + the date dimension: the resulting table has one row per date for each day + during which a prescription was active based on \code{prescription_start} + and \code{prescription_end} fields. Each \code{prescription_id} and \code{date} + combination is accompanied by the \emph{pro rata} day of therapy for that particular + date in the \code{DOT_prescribed} variable.} + \item{\code{bridge_inpatient_episodes_date()}}{Links inpatient episodes with + the date dimension: the resulting table has one row per date for each encounter + episode was taking place. Each \code{encounter_id}, \code{episode_number} and \code{date} + combination is accompanied by the \emph{pro rata} length of stay in the + \code{bed_days} variable.} } } \seealso{ diff --git a/man/create_reporting_inpatient.Rd b/man/create_reporting_inpatient.Rd new file mode 100644 index 0000000..0476963 --- /dev/null +++ b/man/create_reporting_inpatient.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bridge_and_metrics.R +\name{create_reporting_inpatient} +\alias{create_reporting_inpatient} +\title{Build a reporting hypercube for inpatient activity} +\usage{ +create_reporting_inpatient(conn) +} +\arguments{ +\item{conn}{a database connection} +} +\value{ +a object of \code{`tbl_sql`} connected to the \code{reporting_inpatient_length_of_stay} table +} +\description{ +Create or overwrite table \code{`hypercube_inpatient`} which reports +on prescribing during inpatient encounters. +} +\details{ +This function may be used after loading records into the Ramses database +to facilitate reporting on inpatient activity. + +DIMENSIONs +The following dimensions are built, if available from the Ramses database +} diff --git a/man/create_reporting_med_prescribing.Rd b/man/create_reporting_med_prescribing.Rd new file mode 100644 index 0000000..b3181ed --- /dev/null +++ b/man/create_reporting_med_prescribing.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bridge_and_metrics.R +\name{create_reporting_med_prescribing} +\alias{create_reporting_med_prescribing} +\title{Create prescribing reporting table} +\usage{ +create_reporting_med_prescribing(conn) +} +\arguments{ +\item{conn}{a database connection} +} +\value{ +a object of \code{`tbl_sql`} connected to the \code{metrics_prescribing} table +} +\description{ +Create prescribing reporting table +} +\details{ +#' METRICS + +\itemize{ + \item{DOT_prescribed: } + \item{DOT_administered: } IF AVAILABLE + \item{DDD_prescribed: } IF AVAILABLE + \item{DDD_administered: } IF AVAILABLE +} +} diff --git a/tests/testthat/test-bridge-metrics-Postgres.R b/tests/testthat/test-bridge-metrics-Postgres.R new file mode 100644 index 0000000..1fc88a4 --- /dev/null +++ b/tests/testthat/test-bridge-metrics-Postgres.R @@ -0,0 +1,534 @@ + +test_that(".tbl_add_demographics on Postgres", { + + if (!identical(Sys.getenv("CI_Postgres"), "true")) { + skip("CI_Postgres is set to false") + } + + db_conn <- DBI::dbConnect(RPostgres::Postgres(), + user = "user", + password = "password", + host = "localhost", + dbname = "RamsesDB_testing", + timezone = "UTC") + on.exit({ + .remove_db_tables(conn = db_conn, + DBI::dbListTables(db_conn)) + DBI::dbDisconnect(db_conn) + }) + + DBI::dbWriteTable(conn = db_conn, + name = "bad_table", + value = data.frame(nokey = 1L)) + DBI::dbWriteTable(conn = db_conn, + name = "good_table", + value = data.frame(patient_id = 1L, + variable = "a")) + + expect_error(.tbl_add_demographics(data.frame(not_remote_tbl = 1))) + expect_error(.tbl_add_demographics(dplyr::tbl(db_conn, "bad_table"))) + expect_equal(dplyr::collect(.tbl_add_demographics(dplyr::tbl(db_conn, "good_table"))), + dplyr::collect(dplyr::tbl(db_conn, "good_table"))) + + # Now add demographics to use the full function + DBI::dbWriteTable(conn = db_conn, + name = "patients", + value = data.frame(patient_id = 1L, + sex = 1L)) + expect_equal(dplyr::collect(.tbl_add_demographics(dplyr::tbl(db_conn, "good_table"))), + dplyr::tibble(patient_id = 1L, + variable = "a", + sex = 1L)) + DBI::dbWriteTable(conn = db_conn, + name = "patients", + value = data.frame(patient_id = 1L, + date_of_birth = as.Date("1957-03-25")), + overwrite = TRUE) + expect_equal(dplyr::collect(.tbl_add_demographics(dplyr::tbl(db_conn, "good_table"))), + dplyr::tibble(patient_id = 1L, + variable = "a", + date_of_birth = as.Date("1957-03-25"))) + DBI::dbWriteTable(conn = db_conn, + name = "patients", + value = data.frame(patient_id = 1L, + sex = 1L, + date_of_birth = as.Date("1957-03-25"), + ethnic_category_UK = "A"), + overwrite = TRUE) + expect_equal(dplyr::collect(.tbl_add_demographics(dplyr::tbl(db_conn, "good_table"))), + dplyr::tibble(patient_id = 1L, + variable = "a", + date_of_birth = as.Date("1957-03-25"), + sex = 1L, + ethnic_category_UK = "A")) + +}) + +test_that("bridge_episode_prescription_overlap on Postgres", { + + if (!identical(Sys.getenv("CI_Postgres"), "true")) { + skip("CI_Postgres is set to false") + } + + db_conn <- DBI::dbConnect(RPostgres::Postgres(), + user = "user", + password = "password", + host = "localhost", + dbname="RamsesDB_testing", + timezone = "UTC") + on.exit({ + .remove_db_tables(conn = db_conn, + DBI::dbListTables(db_conn)) + DBI::dbDisconnect(db_conn) + }) + + + test_rx <- dplyr::tibble( + patient_id = 1, + prescription_id = 1:4, + authoring_date = as.POSIXct(c("2017-11-25 12:23:07","2017-11-25 12:23:07", + "2015-03-01 09:20:37", "2015-03-01 09:20:37")), + prescription_start = as.POSIXct(c("2017-11-26 14:04:07","2017-11-26 14:04:07", + "2015-03-01 10:37:37", "2015-03-01 10:37:37")), + prescription_end = as.POSIXct(c("2017-12-01 14:04:07","2017-12-01 14:04:07", + "2015-03-04 10:37:37", "2015-03-04 10:37:37")), + prescription_status = c("completed", "stopped", "cancelled", NA), + prescription_context = c("inpatient", "outpatient", "inpatient", "inpatient"), + dose = c(500, 400, 2, 2), unit = c("mg", "mg", "g", "g"), + route = c("ORAL", "ORAL", "IV", "IV"), + frequency = c("6H", "OD", "6H", "6H"), + daily_frequency = c(4, 1, 4, 4), + DDD = c(1, 1, 4, 4) + ) + + test_ip <- dplyr::tibble( + patient_id = 1, encounter_id = 1, + admission_method = "2", + admission_date = as.POSIXct("2017-11-23 10:47:07"), + discharge_date = as.POSIXct("2017-11-30 14:04:07"), + episode_start = as.POSIXct("2017-11-23 10:47:07"), + episode_end = as.POSIXct("2017-11-30 14:04:07"), + episode_number = 1, + last_episode_in_encounter = 1, + consultant_code = 1, + main_specialty_code = 100 + ) + + expect_error(bridge_episode_prescription_overlap(db_conn)) + + dplyr::copy_to(db_conn, + df = test_rx, + name = "drug_prescriptions") + + expect_error(bridge_episode_prescription_overlap(db_conn)) + + dplyr::copy_to(db_conn, + df = test_ip, + name = "inpatient_episodes") + + expect_true(bridge_episode_prescription_overlap(db_conn)) + + expect_true(DBI::dbExistsTable(db_conn, "bridge_episode_prescription_overlap")) + + expect_equal( + dplyr::arrange( + dplyr::collect(tbl(db_conn, "bridge_episode_prescription_overlap")), + prescription_id + ), + dplyr::tibble( + patient_id = 1, + encounter_id = 1, + episode_number = 1, + prescription_id = 1:2, + t_start = as.POSIXct(c("2017-11-26 14:04:07","2017-11-26 14:04:07"), tz = "UTC"), + t_end = as.POSIXct(c("2017-11-30 14:04:07", "2017-11-30 14:04:07"), tz = "UTC") + ) + ) +}) + +test_that("bridge_episode_prescription_initiation on Postgres", { + + if (!identical(Sys.getenv("CI_Postgres"), "true")) { + skip("CI_Postgres is set to false") + } + + db_conn <- DBI::dbConnect(RPostgres::Postgres(), + user = "user", + password = "password", + host = "localhost", + dbname="RamsesDB_testing", + timezone = "UTC") + on.exit({ + .remove_db_tables(conn = db_conn, + DBI::dbListTables(db_conn)) + DBI::dbDisconnect(db_conn) + }) + + test_rx <- dplyr::tibble( + patient_id = 1, + prescription_id = 1:4, + authoring_date = as.POSIXct(c("2017-11-25 12:23:07","2017-11-25 12:23:07", + "2015-03-01 09:20:37", "2015-03-01 09:20:37")), + prescription_start = as.POSIXct(c("2017-11-26 14:04:07","2017-11-26 14:04:07", + "2015-03-01 10:37:37", "2015-03-01 10:37:37")), + prescription_end = as.POSIXct(c("2017-12-01 14:04:07","2017-12-01 14:04:07", + "2015-03-04 10:37:37", "2015-03-04 10:37:37")), + prescription_status = c("completed", "stopped", "cancelled", NA), + prescription_context = c("inpatient", "outpatient", "inpatient", "inpatient"), + dose = c(500, 400, 2, 2), unit = c("mg", "mg", "g", "g"), + route = c("ORAL", "ORAL", "IV", "IV"), + frequency = c("6H", "OD", "6H", "6H"), + daily_frequency = c(4, 1, 4, 4), + DDD = c(1, 1, 4, 4) + ) + + test_ip <- dplyr::tibble( + patient_id = 1, encounter_id = 1, + admission_method = "2", + admission_date = as.POSIXct("2017-11-23 10:47:07"), + discharge_date = as.POSIXct("2017-11-30 14:04:07"), + episode_start = as.POSIXct("2017-11-23 10:47:07"), + episode_end = as.POSIXct("2017-11-30 14:04:07"), + episode_number = 1, + last_episode_in_encounter = 1, + consultant_code = 1, + main_specialty_code = 100 + ) + + expect_error(bridge_episode_prescription_initiation(db_conn)) + + dplyr::copy_to(db_conn, + df = test_rx, + name = "drug_prescriptions") + + expect_error(bridge_episode_prescription_initiation(db_conn)) + + dplyr::copy_to(db_conn, + df = test_ip, + name = "inpatient_episodes") + + expect_true(bridge_episode_prescription_initiation(db_conn)) + + expect_true(DBI::dbExistsTable(db_conn, "bridge_episode_prescription_initiation")) + + expect_equal( + tbl(db_conn, "bridge_episode_prescription_initiation") %>% + dplyr::arrange(.data$episode_number, .data$prescription_id) %>% + dplyr::collect(), + dplyr::tibble( + patient_id = 1, + encounter_id = 1, + episode_number = 1, + prescription_id = 1:2 + ) + ) +}) + +test_that("bridge_episode_therapy_overlap on Postgres", { + + if (!identical(Sys.getenv("CI_Postgres"), "true")) { + skip("CI_Postgres is set to false") + } + + db_conn <- DBI::dbConnect(RPostgres::Postgres(), + user = "user", + password = "password", + host = "localhost", + dbname="RamsesDB_testing", + timezone = "UTC") + on.exit({ + .remove_db_tables(conn = db_conn, + DBI::dbListTables(db_conn)) + DBI::dbDisconnect(db_conn) + }) + + test_th_span_out <- dplyr::tibble( + patient_id = 1, + therapy_id = 1, + therapy_start = as.POSIXct("2017-11-26 14:04:07"), + therapy_end = as.POSIXct("2017-12-01 14:04:07") + ) + + test_th_within <- dplyr::tibble( + patient_id = 1, + therapy_id = 1, + therapy_start = as.POSIXct("2017-11-26 14:04:07"), + therapy_end = as.POSIXct("2017-11-28 14:04:07") + ) + + test_th_beyond <- dplyr::tibble( + patient_id = 1, + therapy_id = 1, + therapy_start = as.POSIXct("2017-11-20 14:04:07"), + therapy_end = as.POSIXct("2017-12-01 14:04:07") + ) + + test_ip <- dplyr::tibble( + patient_id = 1, encounter_id = 1, + admission_method = "2", + admission_date = as.POSIXct("2017-11-23 10:47:07"), + discharge_date = as.POSIXct("2017-11-30 14:04:07"), + episode_start = as.POSIXct("2017-11-23 10:47:07"), + episode_end = as.POSIXct("2017-11-30 14:04:07"), + episode_number = 1, + last_episode_in_encounter = 1, + consultant_code = 1, + main_specialty_code = 100 + ) + + expect_error(bridge_episode_therapy_overlap(db_conn)) + + dplyr::copy_to(db_conn, + df = test_th_span_out, + name = "drug_therapy_episodes") + + expect_error(bridge_episode_therapy_overlap(db_conn)) + + dplyr::copy_to(db_conn, + df = test_ip, + name = "inpatient_episodes") + + expect_true(bridge_episode_therapy_overlap(db_conn)) + + expect_true(DBI::dbExistsTable(db_conn, "bridge_episode_therapy_overlap")) + + expect_equal( + tbl(db_conn, "bridge_episode_therapy_overlap") %>% + dplyr::arrange(.data$episode_number) %>% + dplyr::collect(), + dplyr::tibble( + patient_id = 1, + encounter_id = 1, + episode_number = 1, + therapy_id = 1, + t_start = as.POSIXct("2017-11-26 14:04:07", tz = "UTC"), + t_end = as.POSIXct("2017-11-30 14:04:07", tz = "UTC") + ) + ) + + dplyr::copy_to(db_conn, + df = test_th_within, + name = "drug_therapy_episodes", + overwrite = TRUE) + + expect_true(bridge_episode_therapy_overlap(db_conn, overwrite = TRUE)) + expect_equal( + tbl(db_conn, "bridge_episode_therapy_overlap") %>% + dplyr::arrange(.data$episode_number) %>% + dplyr::collect(), + dplyr::tibble( + patient_id = 1, + encounter_id = 1, + episode_number = 1, + therapy_id = 1, + t_start = as.POSIXct("2017-11-26 14:04:07", tz = "UTC"), + t_end = as.POSIXct("2017-11-28 14:04:07", tz = "UTC") + ) + ) + + dplyr::copy_to(db_conn, + df = test_th_beyond, + name = "drug_therapy_episodes", + overwrite = TRUE) + + expect_true(bridge_episode_therapy_overlap(db_conn, overwrite = TRUE)) + expect_equal( + tbl(db_conn, "bridge_episode_therapy_overlap") %>% + dplyr::arrange(.data$episode_number) %>% + dplyr::collect(), + dplyr::tibble( + patient_id = 1, + encounter_id = 1, + episode_number = 1, + therapy_id = 1, + t_start = as.POSIXct("2017-11-23 10:47:07", tz = "UTC"), + t_end = as.POSIXct("2017-11-30 14:04:07", tz = "UTC") + ) + ) +}) + +test_that("bridge_drug_prescriptions_date on Postgres", { + + if (!identical(Sys.getenv("CI_Postgres"), "true")) { + skip("CI_Postgres is set to false") + } + + db_conn <- DBI::dbConnect(RPostgres::Postgres(), + user = "user", + password = "password", + host = "localhost", + dbname="RamsesDB_testing", + timezone = "UTC") + on.exit({ + .remove_db_tables(conn = db_conn, + DBI::dbListTables(db_conn)) + DBI::dbDisconnect(db_conn) + }) + + expect_error(bridge_drug_prescriptions_date(db_conn)) + + test_ip <- dplyr::tibble( + patient_id = 1, encounter_id = 1, + admission_method = "2", + admission_date = as.POSIXct("2017-11-23 10:47:07"), + discharge_date = as.POSIXct("2017-11-30 14:04:07"), + episode_start = as.POSIXct("2017-11-23 10:47:07"), + episode_end = as.POSIXct("2017-11-30 11:04:07"), + episode_number = 1, + last_episode_in_encounter = 1, + consultant_code = 1, + main_specialty_code = 100 + ) + + test_rx <- dplyr::tibble( + patient_id = 1, + prescription_id = 1:3, + authoring_date = as.POSIXct(c("2017-11-25 12:23:07","2017-11-25 12:23:07", "2015-03-01 09:20:37")), + prescription_start = as.POSIXct(c("2017-11-26 14:04:07","2017-11-26 14:04:07", "2015-03-01 10:37:37")), + prescription_end = as.POSIXct(c("2017-12-01 14:04:07","2017-12-01 14:04:07", "2015-03-04 10:37:37")), + prescription_status = c("completed", "stopped", "cancelled"), + prescription_context = c("inpatient", "outpatient", "inpatient"), + dose = c(500, 400, 2), unit = c("mg", "mg", "g"), + route = c("ORAL", "ORAL", "IV"), + frequency = c("6H", "12H", "6H"), + daily_frequency = c(4, 2, 4), + DDD = c(1, 2, 4) + ) + + dplyr::copy_to(db_conn, + df = test_rx, + name = "drug_prescriptions") + + dplyr::copy_to(db_conn, + df = test_ip, + name = "inpatient_episodes") + + expect_error(bridge_drug_prescriptions_date(db_conn)) + expect_true(bridge_episode_prescription_overlap(db_conn)) + expect_true(bridge_drug_prescriptions_date(db_conn)) + expect_true(DBI::dbExistsTable(db_conn, "bridge_drug_prescriptions_date")) + + test_output <- dplyr::collect(dplyr::tbl(db_conn, "bridge_drug_prescriptions_date")) + + expect_equal( + dplyr::arrange(test_output, prescription_id, date), + dplyr::tibble( + "patient_id" = 1, + "prescription_id" = c(rep(1, 6), rep(2, 6)), + "date" = c(seq(as.Date("2017-11-26"), as.Date("2017-12-01"), 1), + seq(as.Date("2017-11-26"), as.Date("2017-12-01"), 1)), + "DOT_prescribed_all" = c( + 0.41380787037037, 1, 1, 1, 1, 0.58619212962963, + 0.41380787037037, 1, 1, 1, 1, 0.58619212962963 + ), + "DDD_prescribed_all" = c( + 0.41380787037037, 1, 1, 1, 1, 0.58619212962963, + 0.827615740740741, 2, 2, 2, 2, 1.17238425925926 + ), + "DOT_prescribed_IP_only" = c( + 0.41380787037037, 1, 1, 1, 0.46119212962963, NA, + 0.41380787037037, 1, 1, 1, 0.46119212962963, NA + ), + "DDD_prescribed_IP_only" = c( + 0.41380787037037, 1, 1, 1, 0.46119212962963, NA, + 0.827615740740741, 2, 2, 2, 0.922384259259259, NA + ) + ) + ) +}) + +test_that("bridge_inpatient_episodes_date on Postgres", { + + if (!identical(Sys.getenv("CI_Postgres"), "true")) { + skip("CI_Postgres is set to false") + } + + db_conn <- DBI::dbConnect(RPostgres::Postgres(), + user = "user", + password = "password", + host = "localhost", + dbname="RamsesDB_testing", + timezone = "UTC") + on.exit({ + .remove_db_tables(conn = db_conn, + DBI::dbListTables(db_conn)) + DBI::dbDisconnect(db_conn) + }) + + expect_error(bridge_inpatient_episodes_date(db_conn)) + + test_th_span_out <- dplyr::tibble( + patient_id = 1, + therapy_id = 1, + therapy_start = as.POSIXct("2017-11-26 14:04:07"), + therapy_end = as.POSIXct("2017-12-01 14:04:07") + ) + + test_th_within <- dplyr::tibble( + patient_id = 1, + therapy_id = 1, + therapy_start = as.POSIXct("2017-11-26 14:04:07"), + therapy_end = as.POSIXct("2017-11-28 14:04:07") + ) + + test_ip <- dplyr::tibble( + patient_id = 1, encounter_id = 1, + admission_method = "2", + admission_date = as.POSIXct("2017-11-23 10:47:07"), + discharge_date = as.POSIXct("2017-11-30 14:04:07"), + episode_start = as.POSIXct("2017-11-23 10:47:07"), + episode_end = as.POSIXct("2017-11-30 14:04:07"), + episode_number = 1, + last_episode_in_encounter = 1, + consultant_code = 1, + main_specialty_code = 100 + ) + + dplyr::copy_to(db_conn, + df = test_ip, + name = "inpatient_episodes") + + expect_error(bridge_inpatient_episodes_date(db_conn)) + + dplyr::copy_to(db_conn, + df = test_th_span_out, + name = "drug_therapy_episodes") + + expect_true(bridge_inpatient_episodes_date(db_conn)) + + expect_true(DBI::dbExistsTable(db_conn, "bridge_inpatient_episodes_date")) + + test_output <- dplyr::collect(dplyr::tbl(db_conn, "bridge_inpatient_episodes_date")) + + expect_equal( + dplyr::arrange(test_output, encounter_id, episode_number, date), + dplyr::tibble( + "patient_id" = 1, + "encounter_id" = 1, + "episode_number" = 1, + "date" = seq(as.Date("2017-11-23"), as.Date("2017-11-30"), 1) , + "bed_days" = c(0.550613425925926, 1, 1, 1, 1, 1, 1, 0.58619212962963) + # "DNOT_antibacterial" = c(0.550613425925926, 1, 1, 0.58619212962963, 0, 0, 0, 0), + # "DNOT_antifungal" = c(0.550613425925926, 1, 1, 1, 1, 1, 1, 0.58619212962963) + ) + ) + + dplyr::copy_to(db_conn, + df = test_th_within, + name = "drug_therapy_episodes", + overwrite = TRUE) + expect_true(bridge_inpatient_episodes_date(db_conn, overwrite = TRUE)) + test_output <- dplyr::collect(dplyr::tbl(db_conn, "bridge_inpatient_episodes_date")) + expect_equal( + dplyr::arrange(test_output, encounter_id, episode_number, date), + dplyr::tibble( + "patient_id" = 1, + "encounter_id" = 1, + "episode_number" = 1, + "date" = seq(as.Date("2017-11-23"), as.Date("2017-11-30"), 1), + "bed_days" = c(0.550613425925926, 1, 1, 1, 1, 1, 1, 0.58619212962963) + # "DNOT_antibacterial" = c(0.550613425925926, 1, 1, 0.58619212962963, 0, 0.4138079, 1, 1), + # "DNOT_antifungal" = c(0.550613425925926, 1, 1, 1, 1, 1, 1, 0.58619212962963) + ) + ) +}) diff --git a/tests/testthat/test-bridge-metrics-duckdb.R b/tests/testthat/test-bridge-metrics-duckdb.R new file mode 100644 index 0000000..aa9002b --- /dev/null +++ b/tests/testthat/test-bridge-metrics-duckdb.R @@ -0,0 +1,472 @@ + +test_that(".tbl_add_demographics on DuckDB", { + + db_conn <- DBI::dbConnect(duckdb::duckdb(), ":memory:") + on.exit({ + DBI::dbDisconnect(db_conn, shutdown = TRUE) + }) + DBI::dbWriteTable(conn = db_conn, + name = "bad_table", + value = data.frame(nokey = 1L)) + DBI::dbWriteTable(conn = db_conn, + name = "good_table", + value = data.frame(patient_id = 1L, + variable = "a")) + + expect_error(.tbl_add_demographics(data.frame(not_remote_tbl = 1))) + expect_error(.tbl_add_demographics(dplyr::tbl(db_conn, "bad_table"))) + expect_equal(dplyr::collect(.tbl_add_demographics(dplyr::tbl(db_conn, "good_table"))), + dplyr::collect(dplyr::tbl(db_conn, "good_table"))) + + # Now add demographics to use the full function + DBI::dbWriteTable(conn = db_conn, + name = "patients", + value = data.frame(patient_id = 1L, + sex = 1L)) + expect_equal(dplyr::collect(.tbl_add_demographics(dplyr::tbl(db_conn, "good_table"))), + dplyr::tibble(patient_id = 1L, + variable = "a", + sex = 1L)) + DBI::dbWriteTable(conn = db_conn, + name = "patients", + value = data.frame(patient_id = 1L, + date_of_birth = as.Date("1957-03-25")), + overwrite = TRUE) + expect_equal(dplyr::collect(.tbl_add_demographics(dplyr::tbl(db_conn, "good_table"))), + dplyr::tibble(patient_id = 1L, + variable = "a", + date_of_birth = as.Date("1957-03-25"))) + DBI::dbWriteTable(conn = db_conn, + name = "patients", + value = data.frame(patient_id = 1L, + sex = 1L, + date_of_birth = as.Date("1957-03-25"), + ethnic_category_UK = "A"), + overwrite = TRUE) + expect_equal(dplyr::collect(.tbl_add_demographics(dplyr::tbl(db_conn, "good_table"))), + dplyr::tibble(patient_id = 1L, + variable = "a", + date_of_birth = as.Date("1957-03-25"), + sex = 1L, + ethnic_category_UK = "A")) + +}) + +test_that("bridge_episode_prescription_overlap on DuckDB", { + + db_conn <- DBI::dbConnect(duckdb::duckdb(), dbdir = "test.duckdb") + on.exit({ + DBI::dbDisconnect(db_conn, shutdown = TRUE) + file.remove("test.duckdb") + }) + + test_rx <- dplyr::tibble( + patient_id = 1, + prescription_id = 1:4, + authoring_date = as.POSIXct(c("2017-11-25 12:23:07","2017-11-25 12:23:07", + "2015-03-01 09:20:37", "2015-03-01 09:20:37")), + prescription_start = as.POSIXct(c("2017-11-26 14:04:07","2017-11-26 14:04:07", + "2015-03-01 10:37:37", "2015-03-01 10:37:37")), + prescription_end = as.POSIXct(c("2017-12-01 14:04:07","2017-12-01 14:04:07", + "2015-03-04 10:37:37", "2015-03-04 10:37:37")), + prescription_status = c("completed", "stopped", "cancelled", NA), + prescription_context = c("inpatient", "outpatient", "inpatient", "inpatient"), + dose = c(500, 400, 2, 2), unit = c("mg", "mg", "g", "g"), + route = c("ORAL", "ORAL", "IV", "IV"), + frequency = c("6H", "OD", "6H", "6H"), + daily_frequency = c(4, 1, 4, 4), + DDD = c(1, 1, 4, 4) + ) + + test_ip <- dplyr::tibble( + patient_id = 1, encounter_id = 1, + admission_method = "2", + admission_date = as.POSIXct("2017-11-23 10:47:07"), + discharge_date = as.POSIXct("2017-11-30 14:04:07"), + episode_start = as.POSIXct("2017-11-23 10:47:07"), + episode_end = as.POSIXct("2017-11-30 14:04:07"), + episode_number = 1, + last_episode_in_encounter = 1, + consultant_code = 1, + main_specialty_code = 100 + ) + + expect_error(bridge_episode_prescription_overlap(db_conn)) + + dplyr::copy_to(db_conn, + df = test_rx, + name = "drug_prescriptions") + + expect_error(bridge_episode_prescription_overlap(db_conn)) + + dplyr::copy_to(db_conn, + df = test_ip, + name = "inpatient_episodes") + + expect_true(bridge_episode_prescription_overlap(db_conn)) + + expect_true(DBI::dbExistsTable(db_conn, "bridge_episode_prescription_overlap")) + + expect_equal( + dplyr::arrange( + dplyr::collect(tbl(db_conn, "bridge_episode_prescription_overlap")), + prescription_id + ), + dplyr::tibble( + patient_id = 1, + encounter_id = 1, + episode_number = 1, + prescription_id = 1:2, + t_start = as.POSIXct(c("2017-11-26 14:04:07","2017-11-26 14:04:07"), tz = "UTC"), + t_end = as.POSIXct(c("2017-11-30 14:04:07", "2017-11-30 14:04:07"), tz = "UTC") + ) + ) +}) + +test_that("bridge_episode_prescription_initiation on DuckDB", { + + db_conn <- DBI::dbConnect(duckdb::duckdb(), dbdir = "test.duckdb") + on.exit({ + DBI::dbDisconnect(db_conn, shutdown = TRUE) + file.remove("test.duckdb") + }) + + test_rx <- dplyr::tibble( + patient_id = 1, + prescription_id = 1:4, + authoring_date = as.POSIXct(c("2017-11-25 12:23:07","2017-11-25 12:23:07", + "2015-03-01 09:20:37", "2015-03-01 09:20:37")), + prescription_start = as.POSIXct(c("2017-11-26 14:04:07","2017-11-26 14:04:07", + "2015-03-01 10:37:37", "2015-03-01 10:37:37")), + prescription_end = as.POSIXct(c("2017-12-01 14:04:07","2017-12-01 14:04:07", + "2015-03-04 10:37:37", "2015-03-04 10:37:37")), + prescription_status = c("completed", "stopped", "cancelled", NA), + prescription_context = c("inpatient", "outpatient", "inpatient", "inpatient"), + dose = c(500, 400, 2, 2), unit = c("mg", "mg", "g", "g"), + route = c("ORAL", "ORAL", "IV", "IV"), + frequency = c("6H", "OD", "6H", "6H"), + daily_frequency = c(4, 1, 4, 4), + DDD = c(1, 1, 4, 4) + ) + + test_ip <- dplyr::tibble( + patient_id = 1, encounter_id = 1, + admission_method = "2", + admission_date = as.POSIXct("2017-11-23 10:47:07"), + discharge_date = as.POSIXct("2017-11-30 14:04:07"), + episode_start = as.POSIXct("2017-11-23 10:47:07"), + episode_end = as.POSIXct("2017-11-30 14:04:07"), + episode_number = 1, + last_episode_in_encounter = 1, + consultant_code = 1, + main_specialty_code = 100 + ) + + expect_error(bridge_episode_prescription_initiation(db_conn)) + + dplyr::copy_to(db_conn, + df = test_rx, + name = "drug_prescriptions") + + expect_error(bridge_episode_prescription_initiation(db_conn)) + + dplyr::copy_to(db_conn, + df = test_ip, + name = "inpatient_episodes") + + expect_true(bridge_episode_prescription_initiation(db_conn)) + + expect_true(DBI::dbExistsTable(db_conn, "bridge_episode_prescription_initiation")) + + expect_equal( + tbl(db_conn, "bridge_episode_prescription_initiation") %>% + dplyr::arrange(.data$episode_number, .data$prescription_id) %>% + dplyr::collect(), + dplyr::tibble( + patient_id = 1, + encounter_id = 1, + episode_number = 1, + prescription_id = 1:2 + ) + ) +}) + + +test_that("bridge_episode_therapy_overlap on DuckDB", { + + db_conn <- DBI::dbConnect(duckdb::duckdb(), dbdir = "test.duckdb") + on.exit({ + DBI::dbDisconnect(db_conn, shutdown = TRUE) + file.remove("test.duckdb") + }) + + test_th_span_out <- dplyr::tibble( + patient_id = 1, + therapy_id = 1, + therapy_start = as.POSIXct("2017-11-26 14:04:07"), + therapy_end = as.POSIXct("2017-12-01 14:04:07") + ) + + test_th_within <- dplyr::tibble( + patient_id = 1, + therapy_id = 1, + therapy_start = as.POSIXct("2017-11-26 14:04:07"), + therapy_end = as.POSIXct("2017-11-28 14:04:07") + ) + + test_th_beyond <- dplyr::tibble( + patient_id = 1, + therapy_id = 1, + therapy_start = as.POSIXct("2017-11-20 14:04:07"), + therapy_end = as.POSIXct("2017-12-01 14:04:07") + ) + + test_ip <- dplyr::tibble( + patient_id = 1, encounter_id = 1, + admission_method = "2", + admission_date = as.POSIXct("2017-11-23 10:47:07"), + discharge_date = as.POSIXct("2017-11-30 14:04:07"), + episode_start = as.POSIXct("2017-11-23 10:47:07"), + episode_end = as.POSIXct("2017-11-30 14:04:07"), + episode_number = 1, + last_episode_in_encounter = 1, + consultant_code = 1, + main_specialty_code = 100 + ) + + expect_error(bridge_episode_therapy_overlap(db_conn)) + + dplyr::copy_to(db_conn, + df = test_th_span_out, + name = "drug_therapy_episodes") + + expect_error(bridge_episode_therapy_overlap(db_conn)) + + dplyr::copy_to(db_conn, + df = test_ip, + name = "inpatient_episodes") + + expect_true(bridge_episode_therapy_overlap(db_conn)) + + expect_true(DBI::dbExistsTable(db_conn, "bridge_episode_therapy_overlap")) + + expect_equal( + tbl(db_conn, "bridge_episode_therapy_overlap") %>% + dplyr::arrange(.data$episode_number) %>% + dplyr::collect(), + dplyr::tibble( + patient_id = 1, + encounter_id = 1, + episode_number = 1, + therapy_id = 1, + t_start = as.POSIXct("2017-11-26 14:04:07", tz = "UTC"), + t_end = as.POSIXct("2017-11-30 14:04:07", tz = "UTC") + ) + ) + + dplyr::copy_to(db_conn, + df = test_th_within, + name = "drug_therapy_episodes", + overwrite = TRUE) + + expect_true(bridge_episode_therapy_overlap(db_conn, overwrite = TRUE)) + expect_equal( + tbl(db_conn, "bridge_episode_therapy_overlap") %>% + dplyr::arrange(.data$episode_number) %>% + dplyr::collect(), + dplyr::tibble( + patient_id = 1, + encounter_id = 1, + episode_number = 1, + therapy_id = 1, + t_start = as.POSIXct("2017-11-26 14:04:07", tz = "UTC"), + t_end = as.POSIXct("2017-11-28 14:04:07", tz = "UTC") + ) + ) + + dplyr::copy_to(db_conn, + df = test_th_beyond, + name = "drug_therapy_episodes", + overwrite = TRUE) + + expect_true(bridge_episode_therapy_overlap(db_conn, overwrite = TRUE)) + expect_equal( + tbl(db_conn, "bridge_episode_therapy_overlap") %>% + dplyr::arrange(.data$episode_number) %>% + dplyr::collect(), + dplyr::tibble( + patient_id = 1, + encounter_id = 1, + episode_number = 1, + therapy_id = 1, + t_start = as.POSIXct("2017-11-23 10:47:07", tz = "UTC"), + t_end = as.POSIXct("2017-11-30 14:04:07", tz = "UTC") + ) + ) +}) + +test_that("bridge_drug_prescriptions_date on DuckDB", { + + db_conn <- DBI::dbConnect(duckdb::duckdb(), dbdir = "test.duckdb") + on.exit({ + DBI::dbDisconnect(db_conn, shutdown = TRUE) + file.remove("test.duckdb") + }) + + expect_error(bridge_drug_prescriptions_date(db_conn)) + + test_ip <- dplyr::tibble( + patient_id = 1, encounter_id = 1, + admission_method = "2", + admission_date = as.POSIXct("2017-11-23 10:47:07"), + discharge_date = as.POSIXct("2017-11-30 14:04:07"), + episode_start = as.POSIXct("2017-11-23 10:47:07"), + episode_end = as.POSIXct("2017-11-30 11:04:07"), + episode_number = 1, + last_episode_in_encounter = 1, + consultant_code = 1, + main_specialty_code = 100 + ) + + test_rx <- dplyr::tibble( + patient_id = 1, + prescription_id = 1:3, + authoring_date = as.POSIXct(c("2017-11-25 12:23:07","2017-11-25 12:23:07", "2015-03-01 09:20:37")), + prescription_start = as.POSIXct(c("2017-11-26 14:04:07","2017-11-26 14:04:07", "2015-03-01 10:37:37")), + prescription_end = as.POSIXct(c("2017-12-01 14:04:07","2017-12-01 14:04:07", "2015-03-04 10:37:37")), + prescription_status = c("completed", "stopped", "cancelled"), + prescription_context = c("inpatient", "outpatient", "inpatient"), + dose = c(500, 400, 2), unit = c("mg", "mg", "g"), + route = c("ORAL", "ORAL", "IV"), + frequency = c("6H", "12H", "6H"), + daily_frequency = c(4, 2, 4), + DDD = c(1, 2, 4) + ) + + dplyr::copy_to(db_conn, + df = test_rx, + name = "drug_prescriptions") + + dplyr::copy_to(db_conn, + df = test_ip, + name = "inpatient_episodes") + + expect_error(bridge_drug_prescriptions_date(db_conn)) + expect_true(bridge_episode_prescription_overlap(db_conn)) + expect_true(bridge_drug_prescriptions_date(db_conn)) + expect_true(DBI::dbExistsTable(db_conn, "bridge_drug_prescriptions_date")) + + test_output <- dplyr::collect(dplyr::tbl(db_conn, "bridge_drug_prescriptions_date")) + + expect_equal( + dplyr::arrange(test_output, prescription_id, date), + dplyr::tibble( + "patient_id" = 1, + "prescription_id" = c(rep(1, 6), rep(2, 6)), + "date" = c(seq(as.Date("2017-11-26"), as.Date("2017-12-01"), 1), + seq(as.Date("2017-11-26"), as.Date("2017-12-01"), 1)), + "DOT_prescribed_all" = c( + 0.41380787037037, 1, 1, 1, 1, 0.58619212962963, + 0.41380787037037, 1, 1, 1, 1, 0.58619212962963 + ), + "DDD_prescribed_all" = c( + 0.41380787037037, 1, 1, 1, 1, 0.58619212962963, + 0.827615740740741, 2, 2, 2, 2, 1.17238425925926 + ), + "DOT_prescribed_IP_only" = c( + 0.41380787037037, 1, 1, 1, 0.46119212962963, NA, + 0.41380787037037, 1, 1, 1, 0.46119212962963, NA + ), + "DDD_prescribed_IP_only" = c( + 0.41380787037037, 1, 1, 1, 0.46119212962963, NA, + 0.827615740740741, 2, 2, 2, 0.922384259259259, NA + ) + ) + ) +}) + +test_that("bridge_inpatient_episodes_date on DuckDB", { + + db_conn <- DBI::dbConnect(duckdb::duckdb(), dbdir = "test.duckdb") + on.exit({ + DBI::dbDisconnect(db_conn, shutdown = TRUE) + file.remove("test.duckdb") + }) + + expect_error(bridge_inpatient_episodes_date(db_conn)) + + test_th_span_out <- dplyr::tibble( + patient_id = 1, + therapy_id = 1, + therapy_start = as.POSIXct("2017-11-26 14:04:07"), + therapy_end = as.POSIXct("2017-12-01 14:04:07") + ) + + test_th_within <- dplyr::tibble( + patient_id = 1, + therapy_id = 1, + therapy_start = as.POSIXct("2017-11-26 14:04:07"), + therapy_end = as.POSIXct("2017-11-28 14:04:07") + ) + + test_ip <- dplyr::tibble( + patient_id = 1, encounter_id = 1, + admission_method = "2", + admission_date = as.POSIXct("2017-11-23 10:47:07"), + discharge_date = as.POSIXct("2017-11-30 14:04:07"), + episode_start = as.POSIXct("2017-11-23 10:47:07"), + episode_end = as.POSIXct("2017-11-30 14:04:07"), + episode_number = 1, + last_episode_in_encounter = 1, + consultant_code = 1, + main_specialty_code = 100 + ) + + dplyr::copy_to(db_conn, + df = test_ip, + name = "inpatient_episodes") + + expect_error(bridge_inpatient_episodes_date(db_conn)) + + dplyr::copy_to(db_conn, + df = test_th_span_out, + name = "drug_therapy_episodes") + + expect_true(bridge_inpatient_episodes_date(db_conn)) + + expect_true(DBI::dbExistsTable(db_conn, "bridge_inpatient_episodes_date")) + + test_output <- dplyr::collect(dplyr::tbl(db_conn, "bridge_inpatient_episodes_date")) + + expect_equal( + dplyr::arrange(test_output, encounter_id, episode_number, date), + dplyr::tibble( + "patient_id" = 1, + "encounter_id" = 1, + "episode_number" = 1, + "date" = seq(as.Date("2017-11-23"), as.Date("2017-11-30"), 1) , + "bed_days" = c(0.550613425925926, 1, 1, 1, 1, 1, 1, 0.58619212962963) + # "DNOT_antibacterial" = c(0.550613425925926, 1, 1, 0.58619212962963, 0, 0, 0, 0), + # "DNOT_antifungal" = c(0.550613425925926, 1, 1, 1, 1, 1, 1, 0.58619212962963) + ) + ) + + dplyr::copy_to(db_conn, + df = test_th_within, + name = "drug_therapy_episodes", + overwrite = TRUE) + expect_true(bridge_inpatient_episodes_date(db_conn, overwrite = TRUE)) + test_output <- dplyr::collect(dplyr::tbl(db_conn, "bridge_inpatient_episodes_date")) + expect_equal( + dplyr::arrange(test_output, encounter_id, episode_number, date), + dplyr::tibble( + "patient_id" = 1, + "encounter_id" = 1, + "episode_number" = 1, + "date" = seq(as.Date("2017-11-23"), as.Date("2017-11-30"), 1), + "bed_days" = c(0.550613425925926, 1, 1, 1, 1, 1, 1, 0.58619212962963) + # "DNOT_antibacterial" = c(0.550613425925926, 1, 1, 0.58619212962963, 0, 0.4138079, 1, 1), + # "DNOT_antifungal" = c(0.550613425925926, 1, 1, 1, 1, 1, 1, 0.58619212962963) + ) + ) +}) diff --git a/tests/testthat/test-objects.R b/tests/testthat/test-objects.R index 3332fcd..410b91c 100644 --- a/tests/testthat/test-objects.R +++ b/tests/testthat/test-objects.R @@ -98,7 +98,7 @@ test_that("Patient..interface_methods Postgres", { user = "user", password = "password", host = "localhost", - dbname="RamsesDB", + dbname="RamsesDB_testing", timezone = "UTC") on.exit({ .remove_db_tables(conPostgreSQL, DBI::dbListTables(conPostgreSQL)) @@ -324,7 +324,7 @@ test_that("MedicationRequest..interface_methods Postgres", { user = "user", password = "password", host = "localhost", - dbname="RamsesDB", + dbname="RamsesDB_testing", timezone = "UTC") on.exit({ .remove_db_tables(conPostgreSQL, DBI::dbListTables(conPostgreSQL)) @@ -624,7 +624,7 @@ test_that("TherapyEpisode..interface_methods Postgres", { user = "user", password = "password", host = "localhost", - dbname="RamsesDB", + dbname="RamsesDB_testing", timezone = "UTC") on.exit({ .remove_db_tables(conPostgreSQL, DBI::dbListTables(conPostgreSQL)) @@ -1016,7 +1016,7 @@ test_that("Encounter..interface_methods Postgres", { user = "user", password = "password", host = "localhost", - dbname="RamsesDB", + dbname="RamsesDB_testing", timezone = "UTC") on.exit({ .remove_db_tables(conPostgreSQL, DBI::dbListTables(conPostgreSQL)) diff --git a/tests/testthat/test-warehousing-duckdb.R b/tests/testthat/test-warehousing-duckdb.R index 4e953ed..8857a0e 100644 --- a/tests/testthat/test-warehousing-duckdb.R +++ b/tests/testthat/test-warehousing-duckdb.R @@ -2,7 +2,7 @@ # DuckDB ------------------------------------------------------------------ test_that(".create_sql_primary_key on DuckDB", { - db_conn <- connect_local_database(file = "test.duckdb", timezone = "Europe/London") + db_conn <- connect_local_database(file = "test.duckdb") on.exit({ DBI::dbDisconnect(db_conn, shutdown = TRUE) file.remove("test.duckdb") @@ -36,26 +36,26 @@ test_that(".sql_generate_date_series on DuckDB", { output <- dplyr::tbl(db_conn, "test_table") %>% .sql_generate_date_series(start_dt = "start", end_dt = "end") %>% dplyr::collect() - expect_equal( - dplyr::select(output, "start", "end", "date"), + dplyr::select(output, "start", "end", "date", "date_weight"), dplyr::tibble( start = as.Date("2014-06-16"), end = as.Date("2014-06-22"), - date = seq(as.Date("2014-06-16"), as.Date("2014-06-22"), 1) + date = seq(as.Date("2014-06-16"), as.Date("2014-06-22"), 1), + date_weight = c(1,1,1,1,1,1,0) ) ) output <- dplyr::tbl(db_conn, "test_table") %>% .sql_generate_date_series(start_dt = "starttime", end_dt = "endtime") %>% dplyr::collect() - expect_equal( - dplyr::select(output, "start", "end", "date"), + dplyr::select(output, "start", "end", "date", "date_weight"), dplyr::tibble( start = as.Date("2014-06-16"), end = as.Date("2014-06-22"), - date = seq(as.Date("2014-06-16"), as.Date("2014-06-22"), 1) + date = seq(as.Date("2014-06-16"), as.Date("2014-06-22"), 1), + date_weight = c(0.375,1,1,1,1,1,0.375) ) ) }) @@ -96,56 +96,7 @@ test_that(".build_tally_table on DuckDB", { ) }) -test_that(".update_dimension_date on DuckDB", { - db_conn <- DBI::dbConnect(duckdb::duckdb(), dbdir = "test.duckdb") - on.exit({ - DBI::dbDisconnect(db_conn, shutdown = TRUE) - file.remove("test.duckdb") - }) - - expected_df <- dplyr::tibble( - date = structure(16242, class = "Date"), - date_string_iso = "2014-06-21", - date_string_dd_mm_yyyy = "21/06/2014", - date_string_dd_mm_yy = "21/06/14", - date_string_full = "21 June 2014", - calendar_year = 2014, - calendar_quarter = "Q2", - calendar_month = 6, - calendar_month_name = "June", - calendar_month_short = "Jun", - day = 21, - day_name = "Saturday", - day_name_short = "Sat", - week_day_numeric = 6, - week_starting = "2014-06-16", - week_ending = "2014-06-22", - financial_year_uk = "2014/15", - financial_quarter_uk = "Q1", - financial_year_quarter_uk = "2014/15 Q1" - ) - - .update_dimension_date(db_conn, as.Date("2014-06-21"), as.Date("2014-06-21")) - expect_true(DBI::dbExistsTable(db_conn, "dimension_date")) - expect_equal( - dplyr::collect(dplyr::tbl(db_conn, "dimension_date")), - expected_df - ) - - # Test robustness against violating primary key constraint - .update_dimension_date(db_conn, as.Date("2014-06-21"), as.Date("2014-06-21")) - expect_equal( - dplyr::collect(dplyr::tbl(db_conn, "dimension_date")), - expected_df - ) - - .update_dimension_date(db_conn, as.Date("2014-06-22"), as.Date("2014-06-25")) - - expect_equal( - dplyr::collect(dplyr::tbl(db_conn, "dimension_date"))$date, - seq(as.Date("2014-06-21"), as.Date("2014-06-25"), 1) - ) -}) + test_that(".run_transitive_closure on DuckDB", { @@ -179,59 +130,6 @@ test_that(".run_transitive_closure on DuckDB", { test_solution) }) -test_that(".tbl_add_demographics on DuckDB", { - - db_conn <- DBI::dbConnect(duckdb::duckdb(), ":memory:") - on.exit({ - DBI::dbDisconnect(db_conn, shutdown = TRUE) - }) - DBI::dbWriteTable(conn = db_conn, - name = "bad_table", - value = data.frame(nokey = 1L)) - DBI::dbWriteTable(conn = db_conn, - name = "good_table", - value = data.frame(patient_id = 1L, - variable = "a")) - - expect_error(.tbl_add_demographics(data.frame(not_remote_tbl = 1))) - expect_error(.tbl_add_demographics(dplyr::tbl(db_conn, "bad_table"))) - expect_equal(dplyr::collect(.tbl_add_demographics(dplyr::tbl(db_conn, "good_table"))), - dplyr::collect(dplyr::tbl(db_conn, "good_table"))) - - # Now add demographics to use the full function - DBI::dbWriteTable(conn = db_conn, - name = "patients", - value = data.frame(patient_id = 1L, - sex = 1L)) - expect_equal(dplyr::collect(.tbl_add_demographics(dplyr::tbl(db_conn, "good_table"))), - dplyr::tibble(patient_id = 1L, - variable = "a", - sex = 1L)) - DBI::dbWriteTable(conn = db_conn, - name = "patients", - value = data.frame(patient_id = 1L, - date_of_birth = as.Date("1957-03-25")), - overwrite = TRUE) - expect_equal(dplyr::collect(.tbl_add_demographics(dplyr::tbl(db_conn, "good_table"))), - dplyr::tibble(patient_id = 1L, - variable = "a", - date_of_birth = as.Date("1957-03-25"))) - DBI::dbWriteTable(conn = db_conn, - name = "patients", - value = data.frame(patient_id = 1L, - sex = 1L, - date_of_birth = as.Date("1957-03-25"), - ethnic_category_UK = "A"), - overwrite = TRUE) - expect_equal(dplyr::collect(.tbl_add_demographics(dplyr::tbl(db_conn, "good_table"))), - dplyr::tibble(patient_id = 1L, - variable = "a", - date_of_birth = as.Date("1957-03-25"), - sex = 1L, - ethnic_category_UK = "A")) - -}) - test_that("drug_prescriptions_edges on DuckDB", { db_conn <- suppressWarnings(connect_local_database("test.duckdb")) @@ -262,8 +160,59 @@ test_that("drug_prescriptions_edges on DuckDB", { expect_equal(output, records_edges) }) -test_that("create_mock_database on DuckDB", { +test_that(".update_dimension_date on DuckDB", { + db_conn <- DBI::dbConnect(duckdb::duckdb(), dbdir = "test.duckdb") + on.exit({ + DBI::dbDisconnect(db_conn, shutdown = TRUE) + file.remove("test.duckdb") + }) + + expected_df <- dplyr::tibble( + date = structure(16242, class = "Date"), + date_string_iso = "2014-06-21", + date_string_dd_mm_yyyy = "21/06/2014", + date_string_dd_mm_yy = "21/06/14", + date_string_full = "21 June 2014", + calendar_year = 2014, + calendar_quarter = "Q2", + calendar_month = 6, + calendar_month_name = "June", + calendar_month_short = "Jun", + day = 21, + day_name = "Saturday", + day_name_short = "Sat", + week_day_numeric = 6, + week_starting = "2014-06-16", + week_ending = "2014-06-22", + financial_year_uk = "2014/15", + financial_quarter_uk = "Q1", + financial_year_quarter_uk = "2014/15 Q1" + ) + + .update_dimension_date(db_conn, as.Date("2014-06-21"), as.Date("2014-06-21")) + expect_true(DBI::dbExistsTable(db_conn, "dimension_date")) + expect_equal( + dplyr::collect(dplyr::tbl(db_conn, "dimension_date")), + expected_df + ) + + # Test robustness against violating primary key constraint + .update_dimension_date(db_conn, as.Date("2014-06-21"), as.Date("2014-06-21")) + expect_equal( + dplyr::collect(dplyr::tbl(db_conn, "dimension_date")), + expected_df + ) + + .update_dimension_date(db_conn, as.Date("2014-06-22"), as.Date("2014-06-25")) + + expect_equal( + dplyr::collect(dplyr::tbl(db_conn, "dimension_date"))$date, + seq(as.Date("2014-06-21"), as.Date("2014-06-25"), 1) + ) +}) +test_that("create_mock_database on DuckDB", { + db_conn <- create_mock_database(file = "test.duckdb", silent = TRUE) on.exit({ DBI::dbDisconnect(db_conn, shutdown = TRUE) @@ -271,7 +220,7 @@ test_that("create_mock_database on DuckDB", { }) expect_true(is(db_conn, "duckdb_connection")) - + expect_equal( sort(dplyr::collect(dplyr::tbl(db_conn, "dimension_date"))[["date"]]), seq(as.Date("2014-06-19"), as.Date("2018-01-02"), 1) @@ -298,7 +247,6 @@ test_that("create_mock_database on DuckDB", { expect_equal(.nrow_sql_table(db_conn, "ramses_tally"), 50001) }) - test_that("Ramses on DuckDB (system test)", { db_conn <- suppressWarnings(connect_local_database("test.duckdb", timezone = "Europe/London")) @@ -437,35 +385,77 @@ test_that("Ramses on DuckDB (system test)", { test_bridge_overlap <- tbl( db_conn, "bridge_episode_prescription_overlap") %>% - dplyr::filter(patient_id == "99999999999" & - prescription_id == "89094c5dffaad0e56073adaddf286e73") %>% - dplyr::collect() - expect_equal(round(sum(test_bridge_overlap$DOT_prescribed), 1), 2.0) - expect_equal(round(sum(test_bridge_overlap$DDD_prescribed), 1), 1.3) + dplyr::filter(encounter_id == "3968305736") %>% + dplyr::collect() %>% + dplyr::arrange(dplyr::desc(prescription_id)) + expect_equal( + test_bridge_overlap, + dplyr::tibble( + patient_id = "99999999999", + encounter_id = "3968305736", + episode_number = c(1,2,1,2), + prescription_id = c("89094c5dffaad0e56073adaddf286e73", "89094c5dffaad0e56073adaddf286e73", + "4d611fc8886c23ab047ad5f74e5080d7", "39a786cdb8fd3387a9340928bbaf513f"), + t_start = structure(c(1487019600, 1487088000, 1486991220, 1487195760), + class = c("POSIXct", "POSIXt"), tzone = "Europe/London"), + t_end = structure(c(1487088000, 1487193360, 1487077620, 1487631360), + class = c("POSIXct", "POSIXt"), tzone = "Europe/London") + ) + ) # bridge_episode_prescription_initiation expect_true(bridge_episode_prescription_initiation(db_conn)) expect_error(bridge_episode_prescription_initiation(db_conn)) expect_true(bridge_episode_prescription_initiation(db_conn, overwrite = TRUE)) test_bridge_init <- tbl(db_conn, "bridge_episode_prescription_initiation") %>% + dplyr::filter(encounter_id == "3968305736") %>% + dplyr::collect() + expect_equal( + test_bridge_init, + dplyr::tibble( + patient_id = "99999999999", + encounter_id = "3968305736", + episode_number = c(1L, 1L, 2L), + prescription_id = c("89094c5dffaad0e56073adaddf286e73", + "4d611fc8886c23ab047ad5f74e5080d7", + "39a786cdb8fd3387a9340928bbaf513f") + ) + ) + + # bridge_episode_therapy_overlap + expect_true(bridge_episode_therapy_overlap(db_conn)) + expect_error(bridge_episode_therapy_overlap(db_conn)) + expect_true(bridge_episode_therapy_overlap(db_conn, overwrite = TRUE)) + test_bridge_th_overlap <- tbl(db_conn, "bridge_episode_therapy_overlap") %>% + dplyr::filter(encounter_id == "3968305736") %>% + dplyr::collect() %>% + dplyr::arrange(.data$episode_number) + expect_equal( + test_bridge_th_overlap, + dplyr::tibble( + patient_id = "99999999999", + encounter_id = "3968305736", + episode_number = 1:2, + therapy_id = "4d611fc8886c23ab047ad5f74e5080d7", + t_start = structure(c(1486991220, 1487088000), + class = c("POSIXct", "POSIXt"), tzone = "Europe/London"), + t_end = structure(c(1487088000, 1487631360), + class = c("POSIXct", "POSIXt"), tzone = "Europe/London") + ) + ) + + # bridge_drug_prescriptions_date + expect_true(bridge_drug_prescriptions_date(db_conn)) + expect_error(bridge_drug_prescriptions_date(db_conn)) + expect_true(bridge_drug_prescriptions_date(db_conn, overwrite = TRUE)) + test_bridge_rx_date <- tbl(db_conn, "bridge_drug_prescriptions_date") %>% dplyr::filter(patient_id == "99999999999" & prescription_id == "89094c5dffaad0e56073adaddf286e73") %>% dplyr::collect() - expect_equal(round(test_bridge_init$DOT_prescribed, 1), 2.0) - expect_equal(round(test_bridge_init$DDD_prescribed, 1), 1.3) - - # bridge_encounter_therapy_overlap - expect_true(bridge_encounter_therapy_overlap(db_conn)) - expect_error(bridge_encounter_therapy_overlap(db_conn)) - expect_true(bridge_encounter_therapy_overlap(db_conn, overwrite = TRUE)) - test_bridge_th_overlap <- tbl( - db_conn, - "bridge_encounter_therapy_overlap") %>% - dplyr::filter(patient_id == "99999999999" & - therapy_id == "4d611fc8886c23ab047ad5f74e5080d7") %>% - dplyr::collect() - expect_equal(round(sum(test_bridge_th_overlap$LOT), 1), 7.4) + expect_equal(round(sum(test_bridge_rx_date$DOT_prescribed_IP_only), 1), 2.0) + expect_equal(round(sum(test_bridge_rx_date$DDD_prescribed_IP_only), 1), 1.3) + # all bridges expect_true(bridge_tables(conn = db_conn, overwrite = TRUE)) # date and datetime casting ----------------------------------------------- diff --git a/tests/testthat/test-warehousing-postgres.R b/tests/testthat/test-warehousing-postgres.R index e8ced93..ee47c3a 100644 --- a/tests/testthat/test-warehousing-postgres.R +++ b/tests/testthat/test-warehousing-postgres.R @@ -1,6 +1,33 @@ # PostgreSQL -------------------------------------------------------------- +test_that(".create_sql_primary_key on Postgres", { + if (!identical(Sys.getenv("CI_Postgres"), "true")) { + skip("CI_Postgres is set to false") + } + + pq_conn <- DBI::dbConnect(RPostgres::Postgres(), + user = "user", + password = "password", + host = "localhost", + dbname="RamsesDB_testing", + timezone = "Europe/London") + on.exit({ + .remove_db_tables(conn = pq_conn, + DBI::dbListTables(pq_conn)) + DBI::dbDisconnect(pq_conn) + }) + DBI::dbWriteTable(conn = pq_conn, name = "test_table", + value = data.frame(key = 1:10) ) + .create_sql_primary_key(conn = pq_conn, field = "key", table = "test_table") + expect_error( + DBI::dbWriteTable( + conn = pq_conn, name = "test_table", + value = data.frame(key = 1:10), append = TRUE + ) + ) +}) + test_that(".sql_generate_date_series on Postgres", { if (!identical(Sys.getenv("CI_Postgres"), "true")) { skip("CI_Postgres is set to false") @@ -10,8 +37,8 @@ test_that(".sql_generate_date_series on Postgres", { user = "user", password = "password", host = "localhost", - dbname="RamsesDB", - timezone = "Europe/London") + dbname="RamsesDB_testing", + timezone = "UTC") on.exit({ .remove_db_tables(conn = db_conn, DBI::dbListTables(db_conn)) @@ -28,54 +55,26 @@ test_that(".sql_generate_date_series on Postgres", { output <- dplyr::tbl(db_conn, "test_table") %>% .sql_generate_date_series(start_dt = "start", end_dt = "end") %>% dplyr::collect() - expect_equal( - dplyr::select(output, "start", "end", "date"), + dplyr::select(output, "start", "end", "date", "date_weight"), dplyr::tibble( start = as.Date("2014-06-16"), end = as.Date("2014-06-22"), - date = seq(as.Date("2014-06-16"), as.Date("2014-06-22"), 1) + date = seq(as.Date("2014-06-16"), as.Date("2014-06-22"), 1), + date_weight = c(1,1,1,1,1,1,0) ) ) output <- dplyr::tbl(db_conn, "test_table") %>% .sql_generate_date_series(start_dt = "starttime", end_dt = "endtime") %>% dplyr::collect() - expect_equal( - dplyr::select(output, "start", "end", "date"), + dplyr::select(output, "start", "end", "date", "date_weight"), dplyr::tibble( start = as.Date("2014-06-16"), end = as.Date("2014-06-22"), - date = seq(as.Date("2014-06-16"), as.Date("2014-06-22"), 1) - ) - ) -}) - - -test_that(".create_sql_primary_key on Postgres", { - if (!identical(Sys.getenv("CI_Postgres"), "true")) { - skip("CI_Postgres is set to false") - } - - pq_conn <- DBI::dbConnect(RPostgres::Postgres(), - user = "user", - password = "password", - host = "localhost", - dbname="RamsesDB", - timezone = "Europe/London") - on.exit({ - .remove_db_tables(conn = pq_conn, - DBI::dbListTables(pq_conn)) - DBI::dbDisconnect(pq_conn) - }) - DBI::dbWriteTable(conn = pq_conn, name = "test_table", - value = data.frame(key = 1:10) ) - .create_sql_primary_key(conn = pq_conn, field = "key", table = "test_table") - expect_error( - DBI::dbWriteTable( - conn = pq_conn, name = "test_table", - value = data.frame(key = 1:10), append = TRUE + date = seq(as.Date("2014-06-16"), as.Date("2014-06-22"), 1), + date_weight = c(0.375,1,1,1,1,1,0.375) ) ) }) @@ -89,7 +88,7 @@ test_that(".create_sql_index on Postgres", { user = "user", password = "password", host = "localhost", - dbname="RamsesDB", + dbname="RamsesDB_testing", timezone = "Europe/London") on.exit({ .remove_db_tables(conn = pq_conn, @@ -112,69 +111,6 @@ test_that(".create_sql_index on Postgres", { ) }) - -test_that(".create_dimension_date on Postgres", { - if (!identical(Sys.getenv("CI_Postgres"), "true")) { - skip("CI_Postgres is set to false") - } - - db_conn <- DBI::dbConnect(RPostgres::Postgres(), - user = "user", - password = "password", - host = "localhost", - dbname="RamsesDB", - timezone = "Europe/London") - on.exit({ - .remove_db_tables(conn = db_conn, - DBI::dbListTables(db_conn)) - DBI::dbDisconnect(db_conn) - }) - - expected_df <- dplyr::tibble( - date = structure(16242, class = "Date"), - date_string_iso = "2014-06-21", - date_string_dd_mm_yyyy = "21/06/2014", - date_string_dd_mm_yy = "21/06/14", - date_string_full = "21 June 2014", - calendar_year = 2014, - calendar_quarter = "Q2", - calendar_month = 6, - calendar_month_name = "June", - calendar_month_short = "Jun", - day = 21, - day_name = "Saturday", - day_name_short = "Sat", - week_day_numeric = 6, - week_starting = "2014-06-16", - week_ending = "2014-06-22", - financial_year_uk = "2014/15", - financial_quarter_uk = "Q1", - financial_year_quarter_uk = "2014/15 Q1" - ) - - .update_dimension_date(db_conn, as.Date("2014-06-21"), as.Date("2014-06-21")) - expect_true(DBI::dbExistsTable(db_conn, "dimension_date")) - expect_equal( - dplyr::collect(dplyr::tbl(db_conn, "dimension_date")), - expected_df - ) - - # Test robustness against violating primary key constraint - .update_dimension_date(db_conn, as.Date("2014-06-21"), as.Date("2014-06-21")) - expect_equal( - dplyr::collect(dplyr::tbl(db_conn, "dimension_date")), - expected_df - ) - - .update_dimension_date(db_conn, as.Date("2014-06-22"), as.Date("2014-06-25")) - - expect_equal( - dplyr::collect(dplyr::tbl(db_conn, "dimension_date"))$date, - seq(as.Date("2014-06-21"), as.Date("2014-06-25"), 1) - ) -}) - - test_that(".build_tally_table on Postgres", { if (!identical(Sys.getenv("CI_Postgres"), "true")) { skip("CI_Postgres is set to false") @@ -184,7 +120,7 @@ test_that(".build_tally_table on Postgres", { user = "user", password = "password", host = "localhost", - dbname="RamsesDB", + dbname="RamsesDB_testing", timezone = "Europe/London") on.exit({ .remove_db_tables(conn = pq_conn, @@ -217,7 +153,7 @@ test_that(".run_transitive_closure on Postgres", { user = "user", password = "password", host = "localhost", - dbname="RamsesDB", + dbname="RamsesDB_testing", timezone = "Europe/London") on.exit({ .remove_db_tables(conn = pq_conn, @@ -241,72 +177,6 @@ test_that(".run_transitive_closure on Postgres", { }) -test_that(".tbl_add_demographics on Postgres", { - - if (!identical(Sys.getenv("CI_Postgres"), "true")) { - skip("CI_Postgres is set to false") - } - - db_conn <- DBI::dbConnect(RPostgres::Postgres(), - user = "user", - password = "password", - host = "localhost", - dbname = "RamsesDB", - timezone = "Europe/London") - on.exit({ - .remove_db_tables(conn = db_conn, - DBI::dbListTables(db_conn)) - DBI::dbDisconnect(db_conn) - }) - - DBI::dbWriteTable(conn = db_conn, - name = "bad_table", - value = data.frame(nokey = 1L)) - DBI::dbWriteTable(conn = db_conn, - name = "good_table", - value = data.frame(patient_id = 1L, - variable = "a")) - - expect_error(.tbl_add_demographics(data.frame(not_remote_tbl = 1))) - expect_error(.tbl_add_demographics(dplyr::tbl(db_conn, "bad_table"))) - expect_equal(dplyr::collect(.tbl_add_demographics(dplyr::tbl(db_conn, "good_table"))), - dplyr::collect(dplyr::tbl(db_conn, "good_table"))) - - # Now add demographics to use the full function - DBI::dbWriteTable(conn = db_conn, - name = "patients", - value = data.frame(patient_id = 1L, - sex = 1L)) - expect_equal(dplyr::collect(.tbl_add_demographics(dplyr::tbl(db_conn, "good_table"))), - dplyr::tibble(patient_id = 1L, - variable = "a", - sex = 1L)) - DBI::dbWriteTable(conn = db_conn, - name = "patients", - value = data.frame(patient_id = 1L, - date_of_birth = as.Date("1957-03-25")), - overwrite = TRUE) - expect_equal(dplyr::collect(.tbl_add_demographics(dplyr::tbl(db_conn, "good_table"))), - dplyr::tibble(patient_id = 1L, - variable = "a", - date_of_birth = as.Date("1957-03-25"))) - DBI::dbWriteTable(conn = db_conn, - name = "patients", - value = data.frame(patient_id = 1L, - sex = 1L, - date_of_birth = as.Date("1957-03-25"), - ethnic_category_UK = "A"), - overwrite = TRUE) - expect_equal(dplyr::collect(.tbl_add_demographics(dplyr::tbl(db_conn, "good_table"))), - dplyr::tibble(patient_id = 1L, - variable = "a", - date_of_birth = as.Date("1957-03-25"), - sex = 1L, - ethnic_category_UK = "A")) - -}) - - test_that("drug_prescriptions_edges on Postgres", { if (!identical(Sys.getenv("CI_Postgres"), "true")) { @@ -317,7 +187,7 @@ test_that("drug_prescriptions_edges on Postgres", { user = "user", password = "password", host = "localhost", - dbname = "RamsesDB", + dbname = "RamsesDB_testing", timezone = "Europe/London") on.exit({ .remove_db_tables(conn = pq_conn, @@ -347,6 +217,66 @@ test_that("drug_prescriptions_edges on Postgres", { expect_equal(output, records_edges) }) +test_that(".update_dimension_date on Postgres", { + if (!identical(Sys.getenv("CI_Postgres"), "true")) { + skip("CI_Postgres is set to false") + } + + db_conn <- DBI::dbConnect(RPostgres::Postgres(), + user = "user", + password = "password", + host = "localhost", + dbname="RamsesDB_testing", + timezone = "Europe/London") + on.exit({ + .remove_db_tables(conn = db_conn, + DBI::dbListTables(db_conn)) + DBI::dbDisconnect(db_conn) + }) + + expected_df <- dplyr::tibble( + date = structure(16242, class = "Date"), + date_string_iso = "2014-06-21", + date_string_dd_mm_yyyy = "21/06/2014", + date_string_dd_mm_yy = "21/06/14", + date_string_full = "21 June 2014", + calendar_year = 2014, + calendar_quarter = "Q2", + calendar_month = 6, + calendar_month_name = "June", + calendar_month_short = "Jun", + day = 21, + day_name = "Saturday", + day_name_short = "Sat", + week_day_numeric = 6, + week_starting = "2014-06-16", + week_ending = "2014-06-22", + financial_year_uk = "2014/15", + financial_quarter_uk = "Q1", + financial_year_quarter_uk = "2014/15 Q1" + ) + + .update_dimension_date(db_conn, as.Date("2014-06-21"), as.Date("2014-06-21")) + expect_true(DBI::dbExistsTable(db_conn, "dimension_date")) + expect_equal( + dplyr::collect(dplyr::tbl(db_conn, "dimension_date")), + expected_df + ) + + # Test robustness against violating primary key constraint + .update_dimension_date(db_conn, as.Date("2014-06-21"), as.Date("2014-06-21")) + expect_equal( + dplyr::collect(dplyr::tbl(db_conn, "dimension_date")), + expected_df + ) + + .update_dimension_date(db_conn, as.Date("2014-06-22"), as.Date("2014-06-25")) + + expect_equal( + dplyr::collect(dplyr::tbl(db_conn, "dimension_date"))$date, + seq(as.Date("2014-06-21"), as.Date("2014-06-25"), 1) + ) +}) test_that("Ramses on PosgreSQL (system test)", { @@ -358,7 +288,7 @@ test_that("Ramses on PosgreSQL (system test)", { user = "user", password = "password", host = "localhost", - dbname="RamsesDB", + dbname="RamsesDB_testing", timezone = "Europe/London") on.exit({ .remove_db_tables(conn = pq_conn, @@ -500,37 +430,81 @@ test_that("Ramses on PosgreSQL (system test)", { test_bridge_overlap <- tbl( pq_conn, "bridge_episode_prescription_overlap") %>% - dplyr::filter(patient_id == "99999999999" & - prescription_id == "89094c5dffaad0e56073adaddf286e73") %>% - dplyr::collect() - expect_equal(round(sum(test_bridge_overlap$DOT_prescribed), 1), 2.0) - expect_equal(round(sum(test_bridge_overlap$DDD_prescribed), 1), 1.3) + dplyr::filter(encounter_id == "3968305736") %>% + dplyr::collect() %>% + dplyr::arrange(dplyr::desc(prescription_id)) + expect_equal( + test_bridge_overlap, + dplyr::tibble( + patient_id = "99999999999", + encounter_id = "3968305736", + episode_number = c(1,2,1,2), + prescription_id = c("89094c5dffaad0e56073adaddf286e73", "89094c5dffaad0e56073adaddf286e73", + "4d611fc8886c23ab047ad5f74e5080d7", "39a786cdb8fd3387a9340928bbaf513f"), + t_start = structure(c(1487019600, 1487088000, 1486991220, 1487195760), + class = c("POSIXct", "POSIXt"), tzone = "Europe/London"), + t_end = structure(c(1487088000, 1487193360, 1487077620, 1487631360), + class = c("POSIXct", "POSIXt"), tzone = "Europe/London") + ) + ) # bridge_episode_prescription_initiation expect_true(bridge_episode_prescription_initiation(pq_conn)) expect_error(bridge_episode_prescription_initiation(pq_conn)) expect_true(bridge_episode_prescription_initiation(pq_conn, overwrite = TRUE)) test_bridge_init <- tbl(pq_conn, "bridge_episode_prescription_initiation") %>% - dplyr::filter(patient_id == "99999999999" & - prescription_id == "89094c5dffaad0e56073adaddf286e73") %>% + dplyr::filter(encounter_id == "3968305736") %>% dplyr::collect() - expect_equal(round(test_bridge_init$DOT_prescribed, 1), 2.0) - expect_equal(round(test_bridge_init$DDD_prescribed, 1), 1.3) - - # bridge_encounter_therapy_overlap - expect_true(bridge_encounter_therapy_overlap(pq_conn)) - expect_error(bridge_encounter_therapy_overlap(pq_conn)) - expect_true(bridge_encounter_therapy_overlap(pq_conn, overwrite = TRUE)) - test_bridge_th_overlap <- tbl( + expect_equal( + test_bridge_init, + dplyr::tibble( + patient_id = "99999999999", + encounter_id = "3968305736", + episode_number = c(1L, 1L, 2L), + prescription_id = c("89094c5dffaad0e56073adaddf286e73", + "4d611fc8886c23ab047ad5f74e5080d7", + "39a786cdb8fd3387a9340928bbaf513f") + ) + ) + + # bridge_episode_therapy_overlap + expect_true(bridge_episode_therapy_overlap(pq_conn)) + expect_error(bridge_episode_therapy_overlap(pq_conn)) + expect_true(bridge_episode_therapy_overlap(pq_conn, overwrite = TRUE)) + test_bridge_th_overlap <- tbl(pq_conn, "bridge_episode_therapy_overlap") %>% + dplyr::filter(encounter_id == "3968305736") %>% + dplyr::collect() %>% + dplyr::arrange(.data$episode_number) + expect_equal( + test_bridge_th_overlap, + dplyr::tibble( + patient_id = "99999999999", + encounter_id = "3968305736", + episode_number = 1:2, + therapy_id = "4d611fc8886c23ab047ad5f74e5080d7", + t_start = structure(c(1486991220, 1487088000), + class = c("POSIXct", "POSIXt"), tzone = "Europe/London"), + t_end = structure(c(1487088000, 1487631360), + class = c("POSIXct", "POSIXt"), tzone = "Europe/London") + ) + ) + + # bridge_drug_prescriptions_date + expect_true(bridge_drug_prescriptions_date(pq_conn)) + expect_error(bridge_drug_prescriptions_date(pq_conn)) + expect_true(bridge_drug_prescriptions_date(pq_conn, overwrite = TRUE)) + test_bridge_rx_date <- tbl( pq_conn, - "bridge_encounter_therapy_overlap") %>% - dplyr::filter(patient_id == "99999999999" & - therapy_id == "4d611fc8886c23ab047ad5f74e5080d7") %>% + "bridge_drug_prescriptions_date") %>% + dplyr::filter(patient_id == "99999999999" & + prescription_id == "89094c5dffaad0e56073adaddf286e73") %>% dplyr::collect() - expect_equal(round(sum(test_bridge_th_overlap$LOT), 1), 7.4) + expect_equal(round(sum(test_bridge_rx_date$DOT_prescribed_IP_only), 1), 2.0) + expect_equal(round(sum(test_bridge_rx_date$DDD_prescribed_IP_only), 1), 1.3) + # all bridges expect_true(bridge_tables(conn = pq_conn, overwrite = TRUE)) - + # date and datetime casting ----------------------------------------------- test_date <- tbl(pq_conn, "inpatient_episodes") %>% @@ -1077,7 +1051,7 @@ test_that("Encounter class on Postgres", { user = "user", password = "password", host = "localhost", - dbname="RamsesDB", + dbname="RamsesDB_testing", timezone = "UTC") on.exit({ .remove_db_tables(conn = pq_conn, diff --git a/vignettes/Ramses.Rmd b/vignettes/Ramses.Rmd index 0b57f57..9a618f2 100644 --- a/vignettes/Ramses.Rmd +++ b/vignettes/Ramses.Rmd @@ -88,6 +88,10 @@ library(Ramses) library(ggplot2) library(dplyr) ramses_db <- create_mock_database("ramses-db.duckdb") + +invisible(create_reporting_inpatient(ramses_db)) +invisible(create_reporting_med_prescribing(ramses_db)) + ``` ## Visualisation @@ -105,6 +109,11 @@ therapy_timeline(Patient(conn = ramses_db, ## Data model +```{r clear_tmp_tbls, include=FALSE} +# clear temporary tables (dbplyr_XXX) +Ramses:::.remove_db_tables(ramses_db, grep("^dbplyr_", DBI::dbListTables(ramses_db), value = TRUE)) +``` + ```{r list_tables} DBI::dbListTables(ramses_db) ``` @@ -116,12 +125,100 @@ DBI::dbListTables(ramses_db) Three main metrics are used to describe antimicrobial consumption in hospitals: Defined Daily Doses, Days on Therapy, and Length of Therapy. Definitions given by @StanicBenic2018 are reproduced below: -- **Defined Daily Doses (DDDs)** designate "the assumed average maintenance dose per day for a drug used for its main indication in adults" as defined by the WHO Collaborating Centre for Drug Statistics Methodology (@WHO-ATC2020). -- **Days of Therapy (DOTs)** designate "the number of days that a patient receives antibiotics regardless of the dose. When a patient receives more than one antibiotic, more than one DOT may be counted". -- **Length of Therapy (LOT)** designate "the number of days that a patient receives systemic antimicrobial agents, irrespective of the number of different antibiotics. Therefore, LOT will be lower than or equal to days of therapy (DOT) because the DOT is calculated for each antibiotic". +- **Defined Daily Doses (DDDs)** designate "the assumed average maintenance dose per day for a drug used for its main indication in adults" as defined by the WHO Collaborating Centre for Drug Statistics Methodology (@WHO-ATC2020). DDDs may not be a relevant benchmark for children and patients with impaired kidney or liver function. +- **Days of Therapy (DOTs)** designate "the number of days that a patient receives antibiotics regardless of the dose. When a patient receives more than one antibiotic, more than one DOT may be counted". +- **Length of Therapy (LOT)** designates "the number of days that a patient receives systemic antimicrobial agents, irrespective of the number of different antibiotics. Therefore, LOT will be lower than or equal to days of therapy (DOT) because the DOT is calculated for each antibiotic". Formulae are available from @Ibrahim2014 along with a discussion of rates which can be derived from these metrics (eg per 1,000 admissions, per 1,000 bed-days). Statistical adjustment of these metrics is discussed by @VanSanten2018 and @Yu2018. +Ramses facilitates the computation and aggregation of metrics by providing various bridge and reporting tables. + + +### Prescribing reporting table + +```{r v_metrics_prescribing} +tbl(ramses_db, "metrics_prescribing") %>% + dplyr::glimpse() +``` + +The `metrics_prescribing` table is built by splitting prescriptions by calendar dates and computing the DOT and DDD metrics (provided that DDDs were loaded into the `drug_prescriptions` table). This table is build for all prescriptions that were in fact administered. Prescriptions with a `prescription_status` marked as "cancelled", "on-hold" or "unknown" are not included in this table but remain in the `drug_prescriptions` table. A number of reporting dimensions are included: + +- medication dimensions: drug type (antibacterial, antifungal, ...), name, group, and ATC category +- demographics available from the `patients` table, such as sex or age, calculated from `date_of_birth` automatically +- route of administration: `ATC_route`, binary `parenteral` versus oral classification +- other dimensions may be fetched by joining with other tables, chiefly `dimension_date` or `reference_aware` + +You may not need to use dimensions and aggregate over the entire set: + +```{r rx_metrics_overall_DOT_hidden, include=FALSE} +rx_metrics_overall_DOT <- tbl(ramses_db, "metrics_prescribing") %>% + summarise(DOT_prescribed_all = sum(DOT_prescribed_all, na.rm = TRUE), + DOT_prescribed_IP_only = sum(DOT_prescribed_IP_only, na.rm = TRUE)) %>% + collect() +``` + +```{r rx_metrics_overall_DOT} +tbl(ramses_db, "metrics_prescribing") %>% + summarise(DOT_prescribed_all = sum(DOT_prescribed_all, na.rm = TRUE), + DOT_prescribed_IP_only = sum(DOT_prescribed_IP_only, na.rm = TRUE)) +``` + +This tables indicates that the data warehouse contains information for a cumulative `r formatC(rx_metrics_overall_DOT$DOT_prescribed_all, format = "fg", digits = 0, big.mark = ",")` days of therapy, including `r formatC(rx_metrics_overall_DOT$DOT_prescribed_IP_only, format = "fg", digits = 0, big.mark = ",")` days of therapy during an inpatient stay. + +It is also possible to aggregate the tables over certain dimensions, for example financial quarter. + +```{r rx_metrics_overall_DOT_plot} +crude_IP_DOTs <- tbl(ramses_db, "metrics_prescribing") %>% + filter(antiinfective_type == "antibacterial") %>% + right_join(tbl(ramses_db, "dimension_date")) %>% + group_by(financial_year_quarter_uk) %>% + summarise(DOT_prescribed_IP_only = sum(DOT_prescribed_IP_only, na.rm = TRUE)) %>% + collect() %>% + arrange(financial_year_quarter_uk) + +ggplot(data = crude_IP_DOTs, + mapping = aes(x = financial_year_quarter_uk, y = DOT_prescribed_IP_only)) + + geom_col() + + scale_y_continuous("Crude total inpatient Days of Therapy", breaks = seq(0, 200, 20)) + + scale_x_discrete(name = NULL) + + theme(axis.text.x = element_text(angle = 45, hjust=1)) +``` + + +### Inpatient reporting table + +To calculate rates of prescribing, inpatient bed days are available in a similar table with a daily resolution: + +```{r} +tbl(ramses_db, "metrics_inpatient") %>% + glimpse() +``` + +```{r, warning=FALSE, message=FALSE} +crude_IP_bed_days <- tbl(ramses_db, "metrics_inpatient") %>% + right_join(tbl(ramses_db, "dimension_date")) %>% + group_by(financial_year_quarter_uk) %>% + summarise(bed_days = sum(bed_days, na.rm = TRUE)) %>% + collect() %>% + arrange(financial_year_quarter_uk) + +crude_IP_prescribing_rates <- left_join(crude_IP_bed_days, crude_IP_DOTs) %>% + mutate(DOT_1000 = tidyr::replace_na(DOT_prescribed_IP_only, 0) / bed_days * 1000) + +ggplot(data = crude_IP_prescribing_rates, + mapping = aes(x = financial_year_quarter_uk, y = DOT_1000)) + + geom_col() + + scale_y_continuous("DOT per 1,000 inpatient bed days", breaks = seq(0, 2000, 100)) + + scale_x_discrete(name = NULL) + + theme(axis.text.x = element_text(angle = 45, hjust=1)) +``` + + + +### DOTs/DDDs based on the episode of administration + + + The approach to create tables of antimicrobial consumption follows three steps: 1. define the study population (encounters for which the above metrics should be derived) @@ -129,44 +226,43 @@ The approach to create tables of antimicrobial consumption follows three steps: 3. compute the metrics by aggregation. -### DOTs/DDDs based on the episode of administration - Consumption can be attributed to specialty based on the specialty of the episode during which the antibiotic is administered. In this case, the appropriate bridge table is `bridge_episode_prescription_overlap`. ```{r AC1, paged.print=FALSE} -study_pop <- tbl(ramses_db, "inpatient_episodes") %>% - filter(main_specialty_code %in% c("100", "101", "300") & - discharge_date >= "2016-01-01") %>% - mutate(calendar_year = year(discharge_date), - calendar_month = month(discharge_date)) - -consumption_num <- study_pop %>% - left_join(tbl(ramses_db, "bridge_episode_prescription_overlap")) %>% - group_by(calendar_year, calendar_month, main_specialty_code) %>% - summarise(DOT_prescribed = sum(coalesce(DOT_prescribed, 0.0)), - DDD_prescribed = sum(coalesce(DDD_prescribed, 0.0))) - -consumption_denom <- study_pop %>% - group_by(calendar_year, calendar_month, main_specialty_code) %>% - summarise(bed_days = sum(ramses_bed_days)) - -consumption_rates <- full_join(consumption_denom, consumption_num) %>% - collect() %>% - mutate(month_starting = as.Date(paste0(calendar_year, "/", calendar_month, "/01"))) -head(consumption_rates) +# study_pop <- tbl(ramses_db, "inpatient_episodes") %>% +# filter(main_specialty_code %in% c("100", "101", "300") & +# discharge_date >= "2016-01-01") %>% +# mutate(calendar_year = year(discharge_date), +# calendar_month = month(discharge_date)) +# +# consumption_num <- study_pop %>% +# left_join(tbl(ramses_db, "bridge_episode_prescription_overlap")) %>% +# group_by(calendar_year, calendar_month, main_specialty_code) %>% +# summarise(DOT_prescribed = sum(coalesce(DOT_prescribed, 0.0)), +# DDD_prescribed = sum(coalesce(DDD_prescribed, 0.0))) +# +# consumption_denom <- study_pop %>% +# group_by(calendar_year, calendar_month, main_specialty_code) %>% +# summarise(bed_days = sum(ramses_bed_days)) +# +# consumption_rates <- full_join(consumption_denom, consumption_num) %>% +# collect() %>% +# mutate(month_starting = as.Date(paste0(calendar_year, "/", calendar_month, "/01"))) +# +# head(consumption_rates) ``` ```{r plot_AC1, width = 10} -ggplot(consumption_rates, - aes(x = month_starting, - y = DOT_prescribed/bed_days*1000, - group = main_specialty_code, - color = main_specialty_code)) + - geom_line() + - scale_x_date(date_labels = "%b %Y") + - xlab("Month") + - ylab("Days of Therapy (DOTs)\nper 1,000 bed-days") +# ggplot(consumption_rates, +# aes(x = month_starting, +# y = DOT_prescribed/bed_days*1000, +# group = main_specialty_code, +# color = main_specialty_code)) + +# geom_line() + +# scale_x_date(date_labels = "%b %Y") + +# xlab("Month") + +# ylab("Days of Therapy (DOTs)\nper 1,000 bed-days") ``` @@ -176,34 +272,34 @@ Alternatively, consumption can be attributed to the episode when prescriptions a ```{r AC2} -consumption_num_init <- study_pop %>% - left_join(tbl(ramses_db, "bridge_episode_prescription_initiation")) %>% - group_by(calendar_year, calendar_month, main_specialty_code) %>% - summarise(DOT_prescribed = sum(coalesce(DOT_prescribed, 0.0)), - DDD_prescribed = sum(coalesce(DDD_prescribed, 0.0))) - -consumption_denom_init <- study_pop %>% - group_by(calendar_year, calendar_month, main_specialty_code) %>% - summarise( - bed_days = sum(ramses_bed_days), - total_admissions = n_distinct(paste0(patient_id, encounter_id)) - ) - -consumption_rates_init <- full_join(consumption_denom_init, consumption_num_init) %>% - collect() %>% - mutate(month_starting = as.Date(paste0(calendar_year, "/", calendar_month, "/01"))) +# consumption_num_init <- study_pop %>% +# left_join(tbl(ramses_db, "bridge_episode_prescription_initiation")) %>% +# group_by(calendar_year, calendar_month, main_specialty_code) %>% +# summarise(DOT_prescribed = sum(coalesce(DOT_prescribed, 0.0)), +# DDD_prescribed = sum(coalesce(DDD_prescribed, 0.0))) +# +# consumption_denom_init <- study_pop %>% +# group_by(calendar_year, calendar_month, main_specialty_code) %>% +# summarise( +# bed_days = sum(ramses_bed_days), +# total_admissions = n_distinct(paste0(patient_id, encounter_id)) +# ) +# +# consumption_rates_init <- full_join(consumption_denom_init, consumption_num_init) %>% +# collect() %>% +# mutate(month_starting = as.Date(paste0(calendar_year, "/", calendar_month, "/01"))) ``` ```{r plot_AC2} -ggplot(consumption_rates_init, - aes(x = month_starting, - y = DOT_prescribed/total_admissions*1000, - group = main_specialty_code, - color = main_specialty_code)) + - geom_line() + - scale_x_date(date_labels = "%b %Y") + - xlab("Month") + - ylab("Days of Therapy (DOTs)\nper 1,000 admissions") +# ggplot(consumption_rates_init, +# aes(x = month_starting, +# y = DOT_prescribed/total_admissions*1000, +# group = main_specialty_code, +# color = main_specialty_code)) + +# geom_line() + +# scale_x_date(date_labels = "%b %Y") + +# xlab("Month") + +# ylab("Days of Therapy (DOTs)\nper 1,000 admissions") ``` ### Length of therapy @@ -211,37 +307,37 @@ ggplot(consumption_rates_init, Length of Therapy is the time elapsed during a prescribing episodes (sequence of antimicrobial prescriptions separated by at the most 36 hours by default). To measure it, the bridge table `bridge_encounter_therapy_overlap` is available. It calculate the total LOT during between admission and discharge (excluding to-take-home medications). ```{r message=FALSE, results='asis'} -length_therapy_by_encounter <- study_pop %>% - distinct(patient_id, encounter_id, admission_method) %>% - left_join(tbl(ramses_db, "bridge_encounter_therapy_overlap")) %>% - group_by(patient_id, encounter_id, admission_method) %>% - summarise(LOT = sum(LOT, na.rm = T)) %>% - collect() - -length_therapy_by_encounter %>% - group_by(admission_method) %>% - summarise( - `Total admissions` = n(), - `Total admissions with therapy` = sum(!is.na(LOT)), - `Mean LOT` = mean(LOT, na.rm = T), - `Median LOT` = median(LOT, na.rm = T), - percentile25 = quantile(x = LOT, probs = .25, na.rm = T), - percentile75 = quantile(x = LOT, probs = .75, na.rm = T) - ) %>% - transmute( - `Admission method` = case_when( - admission_method == 1 ~ "Elective", - admission_method == 2 ~ "Emergency"), - `Total admissions`, - `Mean LOT`, - `Median LOT`, - `Inter-quartile range` = paste0( - formatC(percentile25, format = "f", digits = 1), - "-", - formatC(percentile75, format = "f", digits = 1) - ) - ) %>% - knitr::kable(digits = 1) +# length_therapy_by_encounter <- study_pop %>% +# distinct(patient_id, encounter_id, admission_method) %>% +# left_join(tbl(ramses_db, "bridge_encounter_therapy_overlap")) %>% +# group_by(patient_id, encounter_id, admission_method) %>% +# summarise(LOT = sum(LOT, na.rm = T)) %>% +# collect() +# +# length_therapy_by_encounter %>% +# group_by(admission_method) %>% +# summarise( +# `Total admissions` = n(), +# `Total admissions with therapy` = sum(!is.na(LOT)), +# `Mean LOT` = mean(LOT, na.rm = T), +# `Median LOT` = median(LOT, na.rm = T), +# percentile25 = quantile(x = LOT, probs = .25, na.rm = T), +# percentile75 = quantile(x = LOT, probs = .75, na.rm = T) +# ) %>% +# transmute( +# `Admission method` = case_when( +# admission_method == 1 ~ "Elective", +# admission_method == 2 ~ "Emergency"), +# `Total admissions`, +# `Mean LOT`, +# `Median LOT`, +# `Inter-quartile range` = paste0( +# formatC(percentile25, format = "f", digits = 1), +# "-", +# formatC(percentile75, format = "f", digits = 1) +# ) +# ) %>% +# knitr::kable(digits = 1) ``` @@ -256,49 +352,49 @@ Unlike before, this task takes three steps: 3. join tables ```{r} -consumption_aware_episodes_num <- tbl(ramses_db, "drug_prescriptions") %>% - select(patient_id, prescription_id, ATC_code, ATC_route) %>% - left_join(tbl(ramses_db, "reference_aware"), - by = c("ATC_code", "ATC_route")) %>% - select(patient_id, prescription_id, aware_category) %>% - left_join(tbl(ramses_db, "bridge_episode_prescription_overlap")) %>% - inner_join(study_pop) %>% - group_by(calendar_year, calendar_month, aware_category) %>% - summarise(DOT_prescribed = sum(coalesce(DOT_prescribed, 0.0))) - -consumption_aware_episodes_denom <- study_pop %>% - group_by(calendar_year, calendar_month) %>% - summarise(bed_days = sum(coalesce(ramses_bed_days, 0.0))) - -consumption_aware_episodes <- left_join( - consumption_aware_episodes_denom, - consumption_aware_episodes_num -) %>% - collect() %>% - mutate(month_starting = as.Date(paste0(calendar_year, "/", calendar_month, "/01")), - aware_category = factor(aware_category, - levels = c("Access", "Watch", "Reserve"))) +# consumption_aware_episodes_num <- tbl(ramses_db, "drug_prescriptions") %>% +# select(patient_id, prescription_id, ATC_code, ATC_route) %>% +# left_join(tbl(ramses_db, "reference_aware"), +# by = c("ATC_code", "ATC_route")) %>% +# select(patient_id, prescription_id, aware_category) %>% +# left_join(tbl(ramses_db, "bridge_episode_prescription_overlap")) %>% +# inner_join(study_pop) %>% +# group_by(calendar_year, calendar_month, aware_category) %>% +# summarise(DOT_prescribed = sum(coalesce(DOT_prescribed, 0.0))) +# +# consumption_aware_episodes_denom <- study_pop %>% +# group_by(calendar_year, calendar_month) %>% +# summarise(bed_days = sum(coalesce(ramses_bed_days, 0.0))) +# +# consumption_aware_episodes <- left_join( +# consumption_aware_episodes_denom, +# consumption_aware_episodes_num +# ) %>% +# collect() %>% +# mutate(month_starting = as.Date(paste0(calendar_year, "/", calendar_month, "/01")), +# aware_category = factor(aware_category, +# levels = c("Access", "Watch", "Reserve"))) ``` ```{r} -aware_colours <- c( - "Access" = "#1cb1d1", - "Watch" = "#008ab1", - "Reserve" = "#ff9667" - ) - -ggplot(consumption_aware_episodes, - aes(x = month_starting, - y = DOT_prescribed/bed_days*1000, - group = aware_category, - color = aware_category)) + - geom_line() + - scale_x_date(date_labels = "%b %Y") + - scale_color_manual(name = "AWaRe category", - values = aware_colours) + - xlab("Month") + - ylab("Days of Therapy (DOTs)\nper 1,000 bed-days") +# aware_colours <- c( +# "Access" = "#1cb1d1", +# "Watch" = "#008ab1", +# "Reserve" = "#ff9667" +# ) +# +# ggplot(consumption_aware_episodes, +# aes(x = month_starting, +# y = DOT_prescribed/bed_days*1000, +# group = aware_category, +# color = aware_category)) + +# geom_line() + +# scale_x_date(date_labels = "%b %Y") + +# scale_color_manual(name = "AWaRe category", +# values = aware_colours) + +# xlab("Month") + +# ylab("Days of Therapy (DOTs)\nper 1,000 bed-days") ```