From ffb70df748fc551fad7aad68f0d5408e825048cc Mon Sep 17 00:00:00 2001
From: Peter Dutey
Date: Thu, 4 Aug 2022 18:12:41 +0100
Subject: [PATCH] add S4 class Encounter #92 and test constuctor, class, show,
compute and collect methods
---
NEWS.md | 4 +-
R/objects.R | 133 +++++++-
man/Encounter.Rd | 30 ++
tests/testthat/test-objects.R | 304 +++++++++++++++---
.../ramses-med-class-diagram.gv | 17 +-
5 files changed, 436 insertions(+), 52 deletions(-)
create mode 100644 man/Encounter.Rd
diff --git a/NEWS.md b/NEWS.md
index ab59688..36ba6c8 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -4,12 +4,12 @@
## Improvements
-* Added new S3 class `Encounter`.
+* Added new S4 class `Encounter` #92
## Breaking changes
* `inpatient_episodes` contains 'encounters' rather than 'spells'. Variable `spell_id`
-is now known as `encounter_id`
+is now known as `encounter_id` #86
*
# Ramses 0.4.3
diff --git a/R/objects.R b/R/objects.R
index 98aec0c..d1866aa 100644
--- a/R/objects.R
+++ b/R/objects.R
@@ -74,7 +74,101 @@ Patient <- function(conn, id) {
record = record)
}
-
+
+# Encounter ---------------------------------------------------------------
+
+
+#' An S4 class to represent inpatient encounters
+#'
+#' @slot id an encounter identifier
+#' @slot conn a database connection
+#' @slot record a \code{tbl_sql} for the corresponding database record
+#' @slot longitudinal_table a \code{tbl_sql} for the longitudinal encounter table
+#' @param id an encounter identifier
+#' @param conn a database connection
+#' @rdname Encounter
+#' @export
+setClass(
+ "Encounter",
+ slot = c(longitudinal_table = "tbl"),
+ contains = "RamsesObject"
+)
+
+#' @rdname Encounter
+#' @export
+Encounter <- function(conn, id) {
+ id <- sort(na.omit(unique(id)))
+ if ( is.null(id) | length(id) < 1) {
+ stop("`id` must contain at least one identifier")
+ }
+ id_data_type <- .sql_data_type(conn = conn,
+ table = "inpatient_episodes",
+ field = "encounter_id")
+ if (is.numeric(id) & id_data_type == "character") {
+ stop("`id` must be character")
+ }
+ if (is.character(id) & id_data_type !="character") {
+ stop(paste("`id` must be", id_data_type))
+ }
+
+ record <- dplyr::inner_join(
+ tbl(conn, "inpatient_episodes"),
+ dplyr::tibble(encounter_id = id),
+ by = "encounter_id", copy = TRUE)
+
+ longitudinal_table <- .longitudinal_table_create.Encounter(
+ conn = conn,
+ id = id
+ )
+
+ # TODO
+ # longitudinal_table <- .longitudinal_table_parenteral_indicator(
+ # longitudinal_table)
+
+ new("Encounter",
+ id = id,
+ conn = conn,
+ record = record,
+ longitudinal_table = longitudinal_table)
+}
+
+#' Create the therapy episode longitudinal table
+#'
+#' @param conn a database connection
+#' @param id a vector of encounter identifiers
+#' @noRd
+.longitudinal_table_create.Encounter <- function(conn, id) {
+
+ .build_tally_table(conn)
+
+ longitudinal_table <- dplyr::inner_join(
+ tbl(conn, "inpatient_episodes"),
+ dplyr::tibble(encounter_id = sort(unique(id))),
+ by = "encounter_id", copy = TRUE
+ ) %>%
+ dplyr::distinct(.data$patient_id,
+ .data$encounter_id,
+ .data$admission_date,
+ .data$discharge_date)
+
+ if(is(conn, "PqConnection") | is(conn, "duckdb_connection")) {
+ tbl(conn, "ramses_tally") %>%
+ dplyr::full_join(longitudinal_table, by = character()) %>%
+ dplyr::mutate(t_start = dplyr::sql("admission_date + interval '1h' * t "))%>%
+ dplyr::filter(.data$t_start < .data$discharge_date) %>%
+ dplyr::mutate(t_end = dplyr::sql("admission_date + interval '1h' * (t + 1)")) %>%
+ dplyr::group_by(.data$patient_id, .data$encounter_id) %>%
+ dplyr::mutate(t_end = dplyr::if_else(
+ .data$t == max(.data$t, na.rm = TRUE),
+ .data$discharge_date,
+ .data$t_end
+ )) %>%
+ dplyr::ungroup()
+ } else {
+ .throw_error_method_not_implemented(".longitudinal_table_create.Encounter()",
+ class(conn))
+ }
+}
# MedicationRequest -------------------------------------------------------
@@ -181,7 +275,7 @@ TherapyEpisode.DBIConnection <- function(conn, id) {
tbl(conn, "drug_therapy_episodes"),
dplyr::tibble(therapy_id = id),
by = "therapy_id", copy = TRUE)
- longitudinal_table <- .longitudinal_table_create(conn = conn,
+ longitudinal_table <- .longitudinal_table_create.TherapyEpisode(conn = conn,
id = id)
longitudinal_table <- .longitudinal_table_parenteral_indicator(longitudinal_table)
new("TherapyEpisode",
@@ -216,7 +310,7 @@ setGeneric(name = "TherapyEpisode", def = TherapyEpisode)
#' @param id a vector of therapy episode character identifiers (by design, Ramses creates
#' this as the identifier of the first prescription ordered in an episode)
#' @noRd
-.longitudinal_table_create <- function(conn, id) {
+.longitudinal_table_create.TherapyEpisode <- function(conn, id) {
.build_tally_table(conn)
@@ -241,7 +335,7 @@ setGeneric(name = "TherapyEpisode", def = TherapyEpisode)
)) %>%
dplyr::ungroup()
} else {
- .throw_error_method_not_implemented(".create_longitudinal_table()",
+ .throw_error_method_not_implemented(".longitudinal_table_create.TherapyEpisode()",
class(conn))
}
}
@@ -510,6 +604,37 @@ setMethod("show", "RamsesObject", function(object) {
print(object@conn)
})
+setMethod("show", "Encounter", function(object) {
+ if( length(object@id) == 1 ) {
+ cat("Encounter", paste(as.character(object@id), collapse = ", "), "\n")
+ } else if( length(object@id) <= 3 ) {
+ cat("Encounters", paste(as.character(object@id), collapse = ", "), "\n")
+ } else if( length(object@id) > 3 ) {
+ cat("Encounters", paste(as.character(object@id)[1:3], collapse = ", "), "...\n")
+ }
+ record <- dplyr::collect(object@record)
+
+ if( nrow(record) == 0 ) {
+ cat("Record is not available.\n")
+ cat("Please check object id is valid\n")
+ } else if( length(object@id) == 1 ) {
+ cat("Patient: ", unique(record$patient_id), "\n")
+ cat("Start: ", as.character(unique(record$admission_date), format = "%Y-%m-%d %H:%M:%S %Z"), "\n")
+ cat("End: ", as.character(unique(record$discharge_date), format = "%Y-%m-%d %H:%M:%S %Z"), "\n\n")
+ } else if( length(object@id) > 1 ) {
+ cat("[total of", length(object@id), "encounters]\n")
+ record <- dplyr::arrange(record, .data$encounter_id, .data$episode_number)
+ if (dplyr::n_distinct(record$patient_id) > 3) {
+ cat("Patients: ", paste(as.character(unique(record$patient_id)[1:3]), collapse = ", "), ", ...\n")
+ } else {
+ cat("Patient(s): ", paste(as.character(unique(record$patient_id)), collapse = ", "), "\n")
+ }
+ }
+
+ cat("\nDatabase connection:\n")
+ show(object@conn)
+})
+
setMethod("show", "TherapyEpisode", function(object) {
if( length(object@id) <= 3 ) {
cat(class(object), paste(as.character(object@id), collapse = ", "), "\n")
diff --git a/man/Encounter.Rd b/man/Encounter.Rd
new file mode 100644
index 0000000..f3d55b9
--- /dev/null
+++ b/man/Encounter.Rd
@@ -0,0 +1,30 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/objects.R
+\docType{class}
+\name{Encounter-class}
+\alias{Encounter-class}
+\alias{Encounter}
+\title{An S4 class to represent inpatient encounters}
+\usage{
+Encounter(conn, id)
+}
+\arguments{
+\item{conn}{a database connection}
+
+\item{id}{an encounter identifier}
+}
+\description{
+An S4 class to represent inpatient encounters
+}
+\section{Slots}{
+
+\describe{
+\item{\code{id}}{an encounter identifier}
+
+\item{\code{conn}}{a database connection}
+
+\item{\code{record}}{a \code{tbl_sql} for the corresponding database record}
+
+\item{\code{longitudinal_table}}{a \code{tbl_sql} for the longitudinal encounter table}
+}}
+
diff --git a/tests/testthat/test-objects.R b/tests/testthat/test-objects.R
index 67ffdd7..c6bfc5d 100644
--- a/tests/testthat/test-objects.R
+++ b/tests/testthat/test-objects.R
@@ -5,21 +5,26 @@ test_that("Patient..constructor", {
on.exit({DBI::dbDisconnect(fake_db_conn, shutdown = TRUE)})
dplyr::copy_to(fake_db_conn, patients, temporary = FALSE)
- expect_error(Patient(fake_db_conn, NA))
- expect_error(Patient(fake_db_conn, c()))
- expect_error(Patient(fake_db_conn, c("a", "b")))
+ expect_error(Patient(fake_db_conn, NA),
+ "`id` must not be NA")
+ expect_error(Patient(fake_db_conn, c()),
+ "`id` must have length 1")
+ expect_error(Patient(fake_db_conn, c("a", "b")),
+ "`id` must have length 1")
patient_object <- Patient(fake_db_conn, "99999999999")
expect_s4_class(patient_object, "Patient")
expect_s4_class(compute(patient_object), "Patient")
expect_is(collect(patient_object), "tbl_df")
- expect_error(Patient(fake_db_conn, 99999999999))
+ expect_error(Patient(fake_db_conn, 99999999999),
+ "`id` must be character")
DBI::dbDisconnect(fake_db_conn, shutdown = TRUE)
# works with integer/numeric
patients <- dplyr::tibble(patient_id = 999)
fake_db_conn <- DBI::dbConnect(duckdb::duckdb(), ":memory:", timezone_out = "UTC")
dplyr::copy_to(fake_db_conn, patients, temporary = FALSE)
- expect_error(Patient(fake_db_conn, "999"))
+ expect_error(Patient(fake_db_conn, "999"),
+ "`id` must be numeric")
expect_s4_class(Patient(fake_db_conn, 999), "Patient")
expect_s4_class(Patient(fake_db_conn, 999L), "Patient")
DBI::dbDisconnect(fake_db_conn, shutdown = TRUE)
@@ -27,7 +32,8 @@ test_that("Patient..constructor", {
patients <- dplyr::tibble(patient_id = 999L)
fake_db_conn <- DBI::dbConnect(duckdb::duckdb(), ":memory:", timezone_out = "UTC")
dplyr::copy_to(fake_db_conn, patients, temporary = FALSE)
- expect_error(Patient(fake_db_conn, "999"))
+ expect_error(Patient(fake_db_conn, "999"),
+ "`id` must be integer")
expect_s4_class(Patient(fake_db_conn, 999), "Patient")
expect_s4_class(Patient(fake_db_conn, 999L), "Patient")
})
@@ -173,12 +179,17 @@ test_that("MedicationRequest..constructor", {
dplyr::tibble(prescription_id = "999999"),
"drug_prescriptions",
temporary = FALSE)
- expect_error(MedicationRequest(fake_db_conn, NA))
- expect_error(MedicationRequest(fake_db_conn, c()))
- expect_warning(MedicationRequest(fake_db_conn, c("a", "b")))
+ on.exit({DBI::dbDisconnect(fake_db_conn, shutdown = TRUE)})
+ expect_error(MedicationRequest(fake_db_conn, NA),
+ "`id` must not be NA")
+ expect_error(MedicationRequest(fake_db_conn, c()),
+ "`id` must have length 1")
+ expect_warning(MedicationRequest(fake_db_conn, c("a", "b")),
+ "`id` must have length 1")
object <- MedicationRequest(fake_db_conn, "999999")
expect_s4_class(object, "MedicationRequest")
- expect_error(MedicationRequest(fake_db_conn, 999999))
+ expect_error(MedicationRequest(fake_db_conn, 999999),
+ "`id` must be character")
DBI::dbDisconnect(fake_db_conn, shutdown = TRUE)
# works with integer/numeric
@@ -187,7 +198,8 @@ test_that("MedicationRequest..constructor", {
dplyr::tibble(prescription_id = 999L),
"drug_prescriptions",
temporary = FALSE)
- expect_error(MedicationRequest(fake_db_conn, "999"))
+ expect_error(MedicationRequest(fake_db_conn, "999"),
+ "`id` must be integer")
expect_s4_class(MedicationRequest(fake_db_conn, 999), "MedicationRequest")
expect_s4_class(MedicationRequest(fake_db_conn, 999L), "MedicationRequest")
DBI::dbDisconnect(fake_db_conn, shutdown = TRUE)
@@ -197,10 +209,10 @@ test_that("MedicationRequest..constructor", {
dplyr::tibble(prescription_id = 999),
"drug_prescriptions",
temporary = FALSE)
- expect_error(MedicationRequest(fake_db_conn, "999"))
+ expect_error(MedicationRequest(fake_db_conn, "999"),
+ "`id` must be numeric")
expect_s4_class(MedicationRequest(fake_db_conn, 999), "MedicationRequest")
expect_s4_class(MedicationRequest(fake_db_conn, 999L), "MedicationRequest")
- DBI::dbDisconnect(fake_db_conn, shutdown = TRUE)
})
@@ -382,33 +394,42 @@ test_that("MedicationRequest..interface_methods Postgres", {
test_that("TherapyEpisode..constructor", {
fake_db_conn <- DBI::dbConnect(duckdb::duckdb(), ":memory:", timezone_out = "UTC")
+ on.exit({DBI::dbDisconnect(fake_db_conn, shutdown = TRUE)})
dplyr::copy_to(fake_db_conn,
- dplyr::tibble(therapy_id = "999999"),
+ dplyr::tibble(
+ patient_id = "9",
+ therapy_id = "999999"
+ ),
"drug_therapy_episodes",
temporary = FALSE)
- expect_error(TherapyEpisode(fake_db_conn, NA))
- expect_error(TherapyEpisode(fake_db_conn, c()))
- expect_error(TherapyEpisode(fake_db_conn, 999999))
- expect_error(TherapyEpisode(fake_db_conn, 999999L))
+ expect_error(TherapyEpisode(fake_db_conn, NA),
+ "`id` must contain at least one identifier")
+ expect_error(TherapyEpisode(fake_db_conn, c()),
+ "`id` must contain at least one identifier")
+ expect_error(TherapyEpisode(fake_db_conn, 999999),
+ "`id` must be character")
+ expect_error(TherapyEpisode(fake_db_conn, 999999L),
+ "`id` must be character")
DBI::dbDisconnect(fake_db_conn, shutdown = TRUE)
# works with integer/numeric
fake_db_conn <- DBI::dbConnect(duckdb::duckdb(), ":memory:", timezone_out = "UTC")
dplyr::copy_to(fake_db_conn,
- dplyr::tibble(therapy_id = 999999L),
+ dplyr::tibble(patient_id = 9L,
+ therapy_id = 999999L),
"drug_therapy_episodes",
temporary = FALSE)
- expect_error(TherapyEpisode(fake_db_conn, "999999"))
+ expect_error(TherapyEpisode(fake_db_conn, "999999"),
+ "`id` must be integer")
DBI::dbDisconnect(fake_db_conn, shutdown = TRUE)
fake_db_conn <- DBI::dbConnect(duckdb::duckdb(), ":memory:", timezone_out = "UTC")
dplyr::copy_to(fake_db_conn,
- dplyr::tibble(therapy_id = 999999),
+ dplyr::tibble(patient_id = 9,
+ therapy_id = 999999),
"drug_therapy_episodes",
temporary = FALSE)
expect_error(TherapyEpisode(fake_db_conn, "999999"))
-
- DBI::dbDisconnect(fake_db_conn, shutdown = TRUE)
})
@@ -578,33 +599,230 @@ test_that("TherapyEpisode..interface_methods Postgres", {
DBI::dbDisconnect(conPostgreSQL)
})
-test_that("TherapyEpisode..constructor", {
+test_that("Encounter..constructor", {
fake_db_conn <- DBI::dbConnect(duckdb::duckdb(), ":memory:", timezone_out = "UTC")
- dplyr::copy_to(fake_db_conn,
- dplyr::tibble(therapy_id = "999999"),
- "drug_therapy_episodes",
- temporary = FALSE)
- expect_error(TherapyEpisode(fake_db_conn, NA))
- expect_error(TherapyEpisode(fake_db_conn, c()))
- expect_error(TherapyEpisode(fake_db_conn, 999999))
- expect_error(TherapyEpisode(fake_db_conn, 999999L))
+ on.exit({DBI::dbDisconnect(fake_db_conn, shutdown = TRUE)})
+ dplyr::copy_to(
+ fake_db_conn,
+ dplyr::tibble(
+ patient_id = "9",
+ encounter_id = "999999"
+ ),
+ "inpatient_episodes",
+ temporary = FALSE
+ )
+ expect_error(Encounter(fake_db_conn, NA),
+ "`id` must contain at least one identifier")
+ expect_error(Encounter(fake_db_conn, c()),
+ "`id` must contain at least one identifier")
+ expect_error(Encounter(fake_db_conn, 999999),
+ "`id` must be character")
+ expect_error(Encounter(fake_db_conn, 999999L),
+ "`id` must be character")
+ expect_s4_class(Encounter(fake_db_conn, "999999"), "Encounter")
DBI::dbDisconnect(fake_db_conn, shutdown = TRUE)
# works with integer/numeric
fake_db_conn <- DBI::dbConnect(duckdb::duckdb(), ":memory:", timezone_out = "UTC")
- dplyr::copy_to(fake_db_conn,
- dplyr::tibble(therapy_id = 999999L),
- "drug_therapy_episodes",
- temporary = FALSE)
- expect_error(TherapyEpisode(fake_db_conn, "999999"))
+ dplyr::copy_to(
+ fake_db_conn,
+ dplyr::tibble(
+ patient_id = 9,
+ encounter_id = 999999
+ ),
+ "inpatient_episodes",
+ temporary = FALSE
+ )
+ expect_error(Encounter(fake_db_conn, "999999"),
+ "`id` must be numeric")
+ expect_s4_class(Encounter(fake_db_conn, 999999), "Encounter")
+ expect_s4_class(Encounter(fake_db_conn, 999999L), "Encounter")
DBI::dbDisconnect(fake_db_conn, shutdown = TRUE)
fake_db_conn <- DBI::dbConnect(duckdb::duckdb(), ":memory:", timezone_out = "UTC")
- dplyr::copy_to(fake_db_conn,
- dplyr::tibble(therapy_id = 999999),
- "drug_therapy_episodes",
- temporary = FALSE)
- expect_error(TherapyEpisode(fake_db_conn, "999999"))
- DBI::dbDisconnect(fake_db_conn, shutdown = TRUE)
+ dplyr::copy_to(
+ fake_db_conn,
+ dplyr::tibble(
+ patient_id = 9L,
+ encounter_id = 999999L
+ ),
+ "inpatient_episodes",
+ temporary = FALSE
+ )
+ expect_error(Encounter(fake_db_conn, "999999"),
+ "`id` must be integer")
+ expect_s4_class(Encounter(fake_db_conn, 999999), "Encounter")
+ expect_s4_class(Encounter(fake_db_conn, 999999L), "Encounter")
})
+
+test_that("Encounter..interface_methods DuckDB", {
+ conDuckDB <- DBI::dbConnect(duckdb::duckdb(), ":memory:", timezone_out = "UTC")
+ on.exit({DBI::dbDisconnect(conDuckDB, shutdown = TRUE)})
+
+ fake_encounters <- dplyr::tibble(
+ patient_id = 6145252493,
+ encounter_id = 5458286195:5458286199,
+ admission_method = "1",
+ admission_date = structure(1443082402, tzone = "UTC", class = c("POSIXct", "POSIXt")),
+ discharge_date = structure(1443118601, tzone = "UTC", class = c("POSIXct", "POSIXt")),
+ episode_number = 1L,
+ last_episode_in_encounter = 1,
+ episode_start = structure(1443082402, tzone = "UTC", class = c("POSIXct", "POSIXt")),
+ episode_end = structure(1443118601, tzone = "UTC", class = c("POSIXct", "POSIXt")),
+ consultant_code = "C1000003",
+ main_specialty_code = "100"
+ )
+ load_inpatient_episodes(
+ conn = conDuckDB,
+ patients_data = dplyr::tibble(patient_id = 6145252493),
+ episodes_data = fake_encounters,
+ overwrite = TRUE
+ )
+ encounter_object <- Encounter(conDuckDB, 5458286195)
+
+ # CLASS
+ expect_equal(
+ class(encounter_object),
+ structure("Encounter", package = "Ramses")
+ )
+
+ # SHOW
+ expect_equal(
+ capture.output(encounter_object)[1:2],
+ c("Encounter 5458286195 ", "Patient: 6145252493 ")
+ )
+ expect_equal(
+ capture.output(Encounter(conDuckDB, 5458286195:5458286196))[1:3],
+ c("Encounters 5458286195, 5458286196 ", "[total of 2 encounters]", "Patient(s): 6145252493 ")
+ )
+ expect_equal(
+ capture.output(Encounter(conDuckDB, 5458286195:5458286199))[1:3],
+ c("Encounters 5458286195, 5458286196, 5458286197 ...",
+ "[total of 5 encounters]",
+ "Patient(s): 6145252493 ")
+ )
+
+ # COMPUTE
+ expect_equal(
+ encounter_object@record$lazy_query$x$x,
+ structure("inpatient_episodes", class = c("ident", "character"))
+ )
+ encounter_object_computed <- compute(encounter_object)
+ expect_true(
+ grepl("^dbplyr_",
+ as.character(
+ encounter_object_computed@record$lazy_query$x
+ ))
+ )
+
+ # COLLECT
+ expect_equal(
+ collect(encounter_object),
+ dplyr::tibble(
+ patient_id = 6145252493,
+ encounter_id = 5458286195,
+ admission_method = "1",
+ admission_date = structure(1443082402, class = c("POSIXct", "POSIXt"), tzone = "UTC"),
+ discharge_date = structure(1443118601, class = c("POSIXct", "POSIXt"), tzone = "UTC"),
+ episode_number = 1L,
+ last_episode_in_encounter = 1,
+ episode_start = structure(1443082402, class = c("POSIXct", "POSIXt"), tzone = "UTC"),
+ episode_end = structure(1443118601, class = c("POSIXct", "POSIXt"), tzone = "UTC"),
+ consultant_code = "C1000003",
+ main_specialty_code = "100",
+ ramses_bed_days = 0.418969907407407
+ )
+ )
+})
+
+
+
+test_that("Encounter..interface_methods Postgres", {
+
+ if (!identical(Sys.getenv("CI"), "true")) {
+ skip("Test only on Travis")
+ }
+
+ conPostgreSQL <- DBI::dbConnect(RPostgres::Postgres(),
+ user = "user",
+ password = "password",
+ host = "localhost",
+ dbname="RamsesDB",
+ timezone = "UTC")
+
+ fake_encounters <- dplyr::tibble(
+ patient_id = 6145252493,
+ encounter_id = 5458286195:5458286199,
+ admission_method = "1",
+ admission_date = structure(1443082402, tzone = "UTC", class = c("POSIXct", "POSIXt")),
+ discharge_date = structure(1443118601, tzone = "UTC", class = c("POSIXct", "POSIXt")),
+ episode_number = 1L,
+ last_episode_in_encounter = 1,
+ episode_start = structure(1443082402, tzone = "UTC", class = c("POSIXct", "POSIXt")),
+ episode_end = structure(1443118601, tzone = "UTC", class = c("POSIXct", "POSIXt")),
+ consultant_code = "C1000003",
+ main_specialty_code = "100"
+ )
+ load_inpatient_episodes(
+ conn = conPostgreSQL,
+ patients_data = dplyr::tibble(patient_id = 6145252493),
+ episodes_data = fake_encounters,
+ overwrite = TRUE
+ )
+ encounter_object <- Encounter(conPostgreSQL, 5458286195)
+
+ # CLASS
+ expect_equal(
+ class(encounter_object),
+ structure("Encounter", package = "Ramses")
+ )
+
+ # SHOW
+ expect_equal(
+ capture.output(encounter_object)[1:2],
+ c("Encounter 5458286195 ", "Patient: 6145252493 ")
+ )
+ expect_equal(
+ capture.output(Encounter(conPostgreSQL, 5458286195:5458286196))[1:3],
+ c("Encounters 5458286195, 5458286196 ", "[total of 2 encounters]", "Patient(s): 6145252493 ")
+ )
+ expect_equal(
+ capture.output(Encounter(conPostgreSQL, 5458286195:5458286199))[1:3],
+ c("Encounters 5458286195, 5458286196, 5458286197 ...",
+ "[total of 5 encounters]",
+ "Patient(s): 6145252493 ")
+ )
+
+ # COMPUTE
+ expect_equal(
+ encounter_object@record$lazy_query$x$x,
+ structure("inpatient_episodes", class = c("ident", "character"))
+ )
+ encounter_object_computed <- compute(encounter_object)
+ expect_true(
+ grepl("^dbplyr_",
+ as.character(
+ encounter_object_computed@record$lazy_query$x
+ ))
+ )
+
+ # COLLECT
+ expect_equal(
+ collect(encounter_object),
+ dplyr::tibble(
+ patient_id = 6145252493,
+ encounter_id = 5458286195,
+ admission_method = "1",
+ admission_date = structure(1443082402, class = c("POSIXct", "POSIXt"), tzone = "UTC"),
+ discharge_date = structure(1443118601, class = c("POSIXct", "POSIXt"), tzone = "UTC"),
+ episode_number = 1L,
+ last_episode_in_encounter = 1,
+ episode_start = structure(1443082402, class = c("POSIXct", "POSIXt"), tzone = "UTC"),
+ episode_end = structure(1443118601, class = c("POSIXct", "POSIXt"), tzone = "UTC"),
+ consultant_code = "C1000003",
+ main_specialty_code = "100",
+ ramses_bed_days = 0.418969907407407
+ )
+ )
+})
\ No newline at end of file
diff --git a/vignettes/ramses-objects/ramses-med-class-diagram.gv b/vignettes/ramses-objects/ramses-med-class-diagram.gv
index 689b5ae..c17009e 100644
--- a/vignettes/ramses-objects/ramses-med-class-diagram.gv
+++ b/vignettes/ramses-objects/ramses-med-class-diagram.gv
@@ -28,7 +28,7 @@ RamsesObject [
label = "{«interface»\n
RamsesObject|
+ class: character\l
- + id: character\l
+ + id: character/integer\l
+ conn: DBIConnection\l
- record: tbl_sql\l|
@@ -70,7 +70,7 @@ Prescription_Combo [
MedicationRequest [
width = 2.7
label = "{MedicationRequest|
- - patient_id\l|
+ \l|
+ MedicationRequest(DBICon, id)\l
+ Patient(): Patient\l
@@ -106,6 +106,17 @@ Patient [
+ therapy_timeline(): htmlwidgets\l}"
]
+Encounter [
+ width = 2.6
+ label = "{Encounter|
+ - longitudinal_table: tbl_sql\l|
+
+ + Encounter(DBICon, id): Encounter\l
+ + Patient(): Patient\l
+ + longitudinal_table(collect = T/F): tbl\l
+ + therapy_timeline(): htmlwidgets\l}"
+]
+
/*
Clinician [
width = 2.5
@@ -123,7 +134,7 @@ Prescription -> Prescription_Combo [dir=back]*/
RamsesObject -> MedicationRequest [dir=back]
RamsesObject -> Patient [dir=back]
-/*RamsesObject -> Clinician [dir=back]*/
+RamsesObject -> Encounter [dir=back]
RamsesObject -> TherapyEpisode [dir=back]
TherapyEpisode -> MedicationRequest [ constraint=false