Merge branch 'release/1.27.0'

Author: pbchase

.github/workflows/run-tests.yaml

@@ -15,10 +15,45 @@ jobs:
 
     env:
       CI: "TRUE"
+      R_LIBS_USER: /github/home/R/x86_64-pc-linux-gnu-library/4.4
+      R_LIB_FOR_PAK: /usr/local/lib/R/site-library
 
     steps:
       - uses: actions/checkout@v2
 
-      - name: Check
+      # Create directories for R libraries if not already present
+      - name: Create R Library Paths
+        run: |
+          mkdir -p /github/home/R/x86_64-pc-linux-gnu-library/4.4
+          mkdir -p renv/library
+
+      # Restore cache for R dependencies
+      - name: Restore R Dependencies Cache
+        uses: actions/cache@v4
+        with:
+          path: |
+            /github/home/R/x86_64-pc-linux-gnu-library/4.4
+            renv/library
+          key: ${{ runner.os }}-r-libs-${{ hashFiles('DESCRIPTION') }}
+          restore-keys: |
+            ${{ runner.os }}-r-libs-
+
+      # Install R dependencies
+      - name: Install R Dependencies
+        uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          cache: false
+
+      # Run tests
+      - name: Run Tests
         run: devtools::test(stop_on_failure = TRUE)
         shell: Rscript {0}
+
+      # Save R dependencies to cache
+      - name: Save R Dependencies Cache
+        uses: actions/cache@v4
+        with:
+          path: |
+            /github/home/R/x86_64-pc-linux-gnu-library/4.4
+            renv/library
+          key: ${{ runner.os }}-r-libs-${{ hashFiles('DESCRIPTION') }}

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: redcapcustodian
 Type: Package
 Title: Data automation for R-centric workflows with a nod towards REDCap
-Version: 1.26.2
+Version: 1.27.0
 Authors@R: c(
   person("Philip", "Chase",
         email = "pbc@ufl.edu",
@@ -61,7 +61,8 @@ Imports:
     vctrs,
     jsonlite,
     openxlsx,
-    quarto
+    quarto,
+    getip
 Suggests:
     RSQLite,
     digest,

Dockerfile

@@ -28,6 +28,7 @@ RUN R -e "install.packages(c( \
   'writexl', \
   'openxlsx', \
   'kableExtra' \
+  'getip' \
 ))"
 
 RUN R -e "devtools::install_github('allanvc/mRpostman')"

NEWS.md

@@ -1,3 +1,9 @@
+# redcapcustodian 1.27.0 (released 2024-12-11)
+- Allow multiple EHR IDs in get_hipaa_disclosure_log_from_ehr_fhir_logs() (@pbchase, #173, #174)
+- Include dependency setup in gh-action for tests (@saipavan10-git, #171)
+- Improve logging for delete_project function (@saipavan10-git, #171)
+- Use parameters in get_hipaa_disclosure_log_from_ehr_fhir_logs.R (@pbchase, @saipavan10-git #162)
+
 # redcapcustodian 1.26.2 (released 2024-11-20)
 - Add new production status (@saipavan10-git, #168, #170)
 - Add log event tables 10,11,12 (@saipavan10-git, #168, #170)

R/delete_project.R

@@ -19,12 +19,11 @@
 #' @examples
 #' \dontrun{
 #' conn <- DBI::dbConnect(...)
-#' delete_project(c(1,2,3), conn)
+#' delete_project(c(1, 2, 3), conn)
 #' }
 #' @export
 
 delete_project <- function(project_id, conn) {
-
   redcap_projects <- DBI::dbGetQuery(
     conn,
     sprintf(
@@ -34,47 +33,86 @@ delete_project <- function(project_id, conn) {
         log_event_table
      from redcap_projects
      where project_id in (%s)",
-     paste0(project_id, collapse = ",")
+      paste0(project_id, collapse = ",")
     )
   )
 
-  # select projects for deletion
   projects_to_delete <- redcap_projects[is.na(redcap_projects$date_deleted), ]
   redcap_project_ids <- projects_to_delete$project_id
   redcap_log_tables <- projects_to_delete$log_event_table
 
+
   if (nrow(projects_to_delete) > 0) {
-    tryCatch({
-      deleted_projects <- DBI::dbExecute(
-        conn,
-        sprintf(
-          "update redcap_projects set date_deleted = now() where project_id in (%s)",
-          paste0(redcap_project_ids, collapse = ",")
-        )
-      )
-    }, error = function(error_message) {
-      print(error_message)
-      return(FALSE)
-    })
+    delete_sql <- sprintf(
+      "UPDATE redcap_projects SET date_deleted = NOW() WHERE project_id IN (%s)",
+      paste0(redcap_project_ids, collapse = ",")
+    )
 
-    # log the event
-    tryCatch({
-      inserted_rows <- purrr::map2(
-        redcap_log_tables,
-        redcap_project_ids,
-        ~ DBI::dbExecute(
-          conn,
-          sprintf(
-            "insert into %s (object_type, event, project_id, description)
-             values ('redcap_projects', 'MANAGE', %d, 'delete project')",
-        .x,
-        .y)
+    tryCatch(
+      {
+        deleted_projects <- DBI::dbExecute(conn, delete_sql)
+      },
+      error = function(error_message) {
+        print(error_message)
+        return(FALSE)
+      }
+    )
+
+    # Define logging parameters
+    ts <- format(Sys.time(), "%Y%m%d%H%M%S") # Time stamp
+    user <- ifelse(is.null(get_script_name()), "admin", get_script_name())
+    ip <- getip::getip("local")
+    page <- "rcc.billing::delete_abandoned_projects"
+    event <- "MANAGE"
+    object_type <- "redcap_projects"
+    description <- "Delete project"
+    legacy <- 0
+    change_reason <- NULL
+
+    tryCatch(
+      {
+        inserted_rows <- purrr::map2(
+          redcap_log_tables,
+          redcap_project_ids,
+          ~ {
+            pk <- .y
+            data_values <- sprintf("project_id = %d", .y)
+
+            DBI::dbExecute(
+              conn,
+              sprintf(
+                "INSERT INTO %s
+                (log_event_id, project_id, ts, user, ip, page, event,
+                 object_type, sql_log, pk, event_id, data_values,
+                 description, legacy, change_reason)
+               VALUES
+                (NULL, %d, '%s', '%s', '%s', '%s', '%s',
+                 '%s', '%s', '%d', NULL, '%s',
+                 '%s', %d, %s)",
+                .x, # Log table
+                .y, # Project ID
+                ts,
+                user,
+                ip,
+                page,
+                event,
+                object_type,
+                delete_sql,
+                pk,
+                data_values,
+                description,
+                legacy,
+                ifelse(is.null(change_reason), "NULL", sprintf("'%s'", change_reason))
+              )
+            )
+          }
         )
-      )
-    }, error = function(error_message) {
-      print(error_message)
-      return(FALSE)
-    })
+      },
+      error = function(error_message) {
+        print(error_message)
+        return(FALSE)
+      }
+    )
   } else {
     deleted_projects <- NULL
     inserted_rows <- NULL

R/get_hipaa_disclosure_log_from_ehr_fhir_logs.R

@@ -5,7 +5,7 @@
 #' 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 ehr_id a vector of REDCap EHR_IDs for the EHR(s) 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
@@ -30,6 +30,13 @@ get_hipaa_disclosure_log_from_ehr_fhir_logs <- function(
     conn,
     ehr_id = NA_real_,
     start_date = as.Date(NA)) {
+
+  # rename parameters for local use
+  ehr_id_local <- ehr_id
+
+  # determine if ehr_id of interest
+  ehr_id_is_na <- length(ehr_id_local) == 1 & all(is.na(ehr_id_local))
+
   # make DBI objects for joins
   user_information <- dplyr::tbl(conn, "redcap_user_information") |>
     dplyr::select(
@@ -49,8 +56,11 @@ get_hipaa_disclosure_log_from_ehr_fhir_logs <- function(
       "project_irb_number"
     )
 
-  disclosures <- dplyr::tbl(conn, "redcap_ehr_fhir_logs") |>
+  disclosures <-
+    dplyr::tbl(conn, "redcap_ehr_fhir_logs") |>
     dplyr::filter(.data$resource_type == "Patient" & .data$mrn != "") |>
+    dplyr::filter(is.na(start_date) | .data$created_at >= start_date) |>
+    dplyr::filter(ehr_id_is_na | .data$ehr_id %in% ehr_id_local) |>
     dplyr::left_join(user_information, by = c("user_id" = "ui_id")) |>
     dplyr::left_join(projects, by = c("project_id")) |>
     dplyr::collect() |>

VERSION

@@ -1 +1 @@
-1.26.2
+1.27.0