Merge pull request #158 from pbchase/add_get_hipaa_disclosure_log_fro…

…m_ehr_fhir_logs

Add get_hipaa_disclosure_log_from_ehr_fhir_logs()

NAMESPACE

@@ -20,6 +20,7 @@ export(export_allocation_tables_from_project)
 export(get_bad_emails_from_individual_emails)
 export(get_bad_emails_from_listserv_digest)
 export(get_current_time)
+export(get_hipaa_disclosure_log_from_ehr_fhir_logs)
 export(get_institutional_person_data)
 export(get_job_duration)
 export(get_package_scope_var)

R/get_hipaa_disclosure_log_from_ehr_fhir_logs.R

@@ -0,0 +1,77 @@
+#' get_hipaa_disclosure_log_from_ehr_fhir_logs
+#' @description
+#' Read a data needed for a HIPAA disclosure log from a REDCap database
+#' given a DBI connection object to the REDCap database and some optional
+#' parameters to narrow the returned result.
+#'
+#' @param conn a DBI connection object to the REDCap database
+#' @param ehr_id the REDCap EHR_ID for the EHR of interest (optional)
+#' @param start_date The first date from which we should return results (optional)
+#'
+#' @return A dataframe suitable for generating a HIPAA disclosure log
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' library(tidyverse)
+#' library(lubridate)
+#' library(REDCapR)
+#' library(dotenv)
+#' library(redcapcustodian)
+#' library(DBI)
+#' library(RMariaDB)
+#'
+#' init_etl("export_fhir_traffic_log")
+#' conn <- connect_to_redcap_db()
+#'
+#' get_hipaa_disclosure_log_from_ehr_fhir_logs(conn)
+#' }
+get_hipaa_disclosure_log_from_ehr_fhir_logs <- function(
+    conn,
+    ehr_id = NA_real_,
+    start_date = as.Date(NA)) {
+  # make DBI objects for joins
+  user_information <- dplyr::tbl(conn, "redcap_user_information") |>
+    dplyr::select(
+      "ui_id",
+      "username"
+    )
+
+  projects <- dplyr::tbl(conn, "redcap_projects") |>
+    dplyr::select(
+      "project_id",
+      "app_title",
+      "project_pi_firstname",
+      "project_pi_mi",
+      "project_pi_lastname",
+      "project_pi_email",
+      "project_pi_alias",
+      "project_irb_number"
+    )
+
+  disclosures <- dplyr::tbl(conn, "redcap_ehr_fhir_logs") |>
+    dplyr::filter(.data$resource_type == "Patient" & .data$mrn != "") |>
+    dplyr::left_join(user_information, by = c("user_id" = "ui_id")) |>
+    dplyr::left_join(projects, by = c("project_id")) |>
+    dplyr::collect() |>
+    dplyr::mutate(disclosure_date = lubridate::floor_date(.data$created_at, unit = "day")) |>
+    dplyr::select(-c("id", "created_at")) |>
+    dplyr::distinct() |>
+    dplyr::arrange(.data$disclosure_date) |>
+    dplyr::rename(redcap_project_name = "app_title") |>
+    dplyr::select(
+      "disclosure_date",
+      "fhir_id",
+      "mrn",
+      "project_irb_number",
+      "project_pi_firstname",
+      "project_pi_mi",
+      "project_pi_lastname",
+      "project_pi_email",
+      "redcap_project_name",
+      "username",
+      dplyr::everything()
+    )
+
+  return(disclosures)
+}

tests/testthat/helper.R

@@ -32,3 +32,8 @@ if (is.null(salt)) {
   set_package_scope_var("salt", paste0(runif(1), runif(1), runif(1)))
   salt <- get_package_scope_var("salt")
 }
+
+# write a dataframe, referenced by 'table_name' to tests/testthat/directory_under_test_path
+write_rds_to_test_dir <- function(table_name, directory_under_test_path) {
+  get(table_name) |> saveRDS(testthat::test_path(directory_under_test_path, paste0(table_name, ".rds")))
+}

tests/testthat/hipaa_disclosure_log/make_hipaa_disclosure_log_test_data.R

@@ -0,0 +1,58 @@
+library(tidyverse)
+library(lubridate)
+library(REDCapR)
+library(dotenv)
+library(redcapcustodian)
+library(DBI)
+library(RMariaDB)
+
+dotenv::load_dot_env("prod.env")
+conn <- connect_to_redcap_db()
+
+project_ids_of_interest <- dplyr::tbl(conn, "redcap_ehr_fhir_logs") |>
+  dplyr::filter(.data$resource_type == "Patient") |>
+  dplyr::distinct(project_id) |>
+  dplyr::collect() |>
+  sample_n(size = 1) |>
+  pull(project_id)
+
+redcap_ehr_fhir_logs <- dplyr::tbl(conn, "redcap_ehr_fhir_logs") |>
+  dplyr::filter(.data$resource_type == "Patient" &
+                  .data$mrn != "" &
+                  project_id == project_ids_of_interest) |>
+  dplyr::collect()
+
+redcap_ui_ids_of_interest <- redcap_ehr_fhir_logs |>
+  dplyr::distinct(user_id) |>
+  dplyr::collect() |>
+  dplyr::pull(user_id)
+
+redcap_user_information <- dplyr::tbl(conn, "redcap_user_information") |>
+  dplyr::filter(ui_id %in% redcap_ui_ids_of_interest) |>
+  dplyr::select(
+    "ui_id",
+    "username"
+  ) |>
+  dplyr::collect()
+
+redcap_projects <- dplyr::tbl(conn, "redcap_projects") |>
+  dplyr::filter(project_id %in% project_ids_of_interest) |>
+  dplyr::select(
+    "project_id",
+    "app_title",
+    "project_pi_firstname",
+    "project_pi_mi",
+    "project_pi_lastname",
+    "project_pi_email",
+    "project_pi_alias",
+    "project_irb_number"
+  ) |>
+  collect()
+
+# Save our test tables
+test_tables <- c(
+  "redcap_ehr_fhir_logs",
+  "redcap_user_information",
+  "redcap_projects"
+)
+purrr::walk(test_tables, write_rds_to_test_dir, "hipaa_disclosure_log")

tests/testthat/test-get_hipaa_disclosure_log_from_ehr_fhir_logs.R

@@ -0,0 +1,29 @@
+testthat::test_that("get_hipaa_disclosure_log_from_ehr_fhir_logs works", {
+  # read our test data
+  directory_under_test_path <- "hipaa_disclosure_log"
+  test_tables <- c(
+    "redcap_ehr_fhir_logs",
+    "redcap_user_information",
+    "redcap_projects"
+  )
+
+  conn <- DBI::dbConnect(duckdb::duckdb(), dbdir = ":memory:")
+  purrr::walk(test_tables, create_a_table_from_rds_test_data, conn, "hipaa_disclosure_log")
+
+  required_names <- c(
+    "disclosure_date", "fhir_id", "mrn", "project_irb_number"
+  )
+
+  result <- get_hipaa_disclosure_log_from_ehr_fhir_logs(conn)
+
+  # test for the required columns
+  testthat::expect_contains(names(result), required_names)
+  # test for at least one row
+  testthat::expect_gt(nrow(result), 0)
+  # test for only distinct rows
+  testthat::expect_equal(
+    nrow(result),
+    result |> distinct(disclosure_date, fhir_id, mrn, project_irb_number, username) |> nrow())
+
+  DBI::dbDisconnect(conn, shutdown=TRUE)
+})