Merge pull request #460 from ezraporter/feature/redcap-event-read

Add `redcap_event_read()` as wrapper for Export Events API method

NAMESPACE

@@ -15,6 +15,7 @@ export(redcap_delete)
 export(redcap_download_file_oneshot)
 export(redcap_download_instrument)
 export(redcap_event_instruments)
+export(redcap_event_read)
 export(redcap_file_download_oneshot)
 export(redcap_file_upload_oneshot)
 export(redcap_instrument_download)

NEWS.md

@@ -60,6 +60,7 @@ This will help extract forms from longitudinal & repeating projects.
 * `sanitized_token()` now accepts an alternative regex pattern.  (Suggested by @maeon & @michalkouril, #370)
 * `redcap_read_eav_oneshot()` is an UNexported function that returns data in an EAV format (#437)
 * `redcap_metadata_read()` now correctly subsets the forms (identified & corrected by @ezraporter, #431 & #445)
+* New `redcap_event_read()` function. Exports metadata associated with a project's longitudinal events (@ezraporter, #457 & #460)
 
 ### Minor Enhancements
 

R/redcap-event-read.R

@@ -0,0 +1,184 @@
+#' @title
+#' Export Events
+#'
+#' @description
+#' Export Events of a REDCap project
+#'
+#' @param redcap_uri The
+#' [uri](https://en.wikipedia.org/wiki/Uniform_Resource_Identifier)/url
+#' of the REDCap server
+#' typically formatted as "https://server.org/apps/redcap/api/".
+#' Required.
+#' @param token The user-specific string that serves as the password for a
+#' project.  Required.
+#' @param verbose A boolean value indicating if `message`s should be printed
+#' to the R console during the operation.  The verbose output might contain
+#' sensitive information (*e.g.* PHI), so turn this off if the output might
+#' be visible somewhere public. Optional.
+#' @param config_options A list of options passed to [httr::POST()].
+#' See details at [httr::httr_options()]. Optional.
+#' @param handle_httr The value passed to the `handle` parameter of
+#' [httr::POST()].
+#' This is useful for only unconventional authentication approaches.  It
+#' should be `NULL` for most institutions.  Optional.
+#'
+#' @return
+#' Currently, a list is returned with the following elements:
+#' * `data`: a [tibble::tibble()] with one row per arm-event combination.  The
+#' columns are `event_name` (a human-friendly string), `arm_num` (an integer),
+#' `unique_event_name` (a string), `custom_event_label` (a string), and
+#' `event_id` (an integer).
+#' * `success`: A boolean value indicating if the operation was apparently
+#' successful.
+#' * `status_code`: The
+#' [http status code](https://en.wikipedia.org/wiki/List_of_HTTP_status_codes)
+#' of the operation.
+#' * `outcome_message`: A human readable string indicating the operation's
+#' outcome.
+#' * `elapsed_seconds`: The duration of the function.
+#' * `raw_text`: If an operation is NOT successful, the text returned by
+#' REDCap.  If an operation is successful, the `raw_text` is returned as an
+#' empty string to save RAM.
+#'
+#' @author
+#' Ezra Porter, Will Beasley
+#'
+#' @references
+#' The official documentation can be found on the 'API Help Page'
+#' and 'API Examples' pages on the REDCap wiki (*i.e.*,
+#' https://community.projectredcap.org/articles/456/api-documentation.html and
+#' https://community.projectredcap.org/articles/462/api-examples.html).
+#' If you do not have an account for the wiki, please ask your campus REDCap
+#' administrator to send you the static material.
+#'
+#' @examples
+#' \dontrun{
+#' uri            <- "https://bbmc.ouhsc.edu/redcap/api/"
+#'
+#' # Query a longitudinal project with a single arm and 3 events
+#' token_1  <- "786334BEB4A87D572DD0E99C4BFCE144"
+#' result_1 <- REDCapR::redcap_event_read(redcap_uri=uri, token=token_1)
+#' result_1$data
+#'
+#' # Query a longitudinal project with 2 arms and complex arm-event mappings
+#' token_2  <- "0434F0E9CF53ED0587847AB6E51DE762"
+#' result_2 <- REDCapR::redcap_event_read(redcap_uri=uri, token=token_2)
+#' result_2$data
+#'
+#' # Query a classic project without events
+#' token_3  <- "D70F9ACD1EDD6F151C6EA78683944E98"
+#' result_3 <- REDCapR::redcap_event_read(redcap_uri=uri, token=token_3)
+#' result_3$data
+#' }
+#' @export
+redcap_event_read <- function(
+    redcap_uri,
+    token,
+    verbose         = TRUE,
+    config_options  = NULL,
+    handle_httr     = NULL
+) {
+
+  checkmate::assert_character(redcap_uri, any.missing=FALSE, len=1, pattern="^.{1,}$")
+  checkmate::assert_character(token     , any.missing=FALSE, len=1, pattern="^.{1,}$")
+
+  token   <- sanitize_token(token)
+  verbose <- verbose_prepare(verbose)
+
+  post_body <-
+    list(
+      token     = token,
+      content   = "event",
+      format    = "csv"
+    )
+
+  try(
+    {
+      # This is the important call that communicates with the REDCap server.
+      kernel <-
+        kernel_api(
+          redcap_uri      = redcap_uri,
+          post_body       = post_body,
+          config_options  = config_options,
+          handle_httr     = handle_httr
+        )
+    },
+    # Don't print the warning in the try block.  Print it below,
+    #   where it's under the control of the caller.
+    silent = TRUE
+  )
+
+  if (exists("kernel")) {
+    if (kernel$success) {
+      outcome_message <- sprintf(
+        paste(
+          "The list of events was retrieved from the REDCap project in %0.1f seconds.",
+          "The http status code was %i."
+        ),
+        kernel$elapsed_seconds,
+        kernel$status_code
+      )
+
+      col_types <- readr::cols(
+        event_name         = readr::col_character(),
+        arm_num            = readr::col_integer(),
+        unique_event_name  = readr::col_character(),
+        custom_event_label = readr::col_character(),
+        event_id           = readr::col_integer()
+      )
+      d <-
+        readr::read_csv(
+          I(kernel$raw_text),
+          col_types = col_types
+        )
+
+      # If an operation is successful, the `raw_text` is no longer returned to save RAM.  The content is not really necessary with httr's status message exposed.
+      kernel$raw_text <- ""
+    } else if (kernel$raw_text == "ERROR: You cannot export events for classic projects") {
+      outcome_message <- sprintf(
+        paste(
+          "A 'classic' REDCap project has no events.  Retrieved in %0.1f seconds.",
+          "The http status code was %i."
+        ),
+        kernel$elapsed_seconds,
+        kernel$status_code
+      )
+
+      d <- tibble::tibble(
+        event_name         = character(0),
+        arm_num            = integer(0),
+        unique_event_name  = character(0),
+        custom_event_label = character(0),
+        event_id           = integer(0)
+      )
+    } else {
+      error_message <- sprintf(
+        paste(
+          "The REDCapR event export failed.",
+          "The http status code was %i.",
+          "The error message was: '%s'."
+        ),
+        kernel$status_code,
+        kernel$raw_text
+      )
+      stop(error_message)
+    }
+  } else {
+    # nocov start
+    error_message <- sprintf("The REDCapR event export failed. The error message was:\n%s.", kernel$raw_text)
+    stop(error_message)
+    # nocov end
+  }
+
+  if (verbose)
+    message(outcome_message)
+
+  list(
+    data                      = d,
+    success                   = kernel$success,
+    status_code               = kernel$status_code,
+    outcome_message           = outcome_message,
+    elapsed_seconds           = kernel$elapsed_seconds,
+    raw_text                  = kernel$raw_text
+  )
+}

inst/test-data/delete-multiple-arm/event.csv

@@ -0,0 +1,4 @@
+event_name,arm_num,unique_event_name,custom_event_label,event_id
+"Event 1",1,event_1_arm_1,,12353
+"Event 1",2,event_1_arm_2,,12354
+"Event 1",3,event_1_arm_3,,12355

inst/test-data/longitudinal-single-arm/event.csv

@@ -0,0 +1,4 @@
+event_name,arm_num,unique_event_name,custom_event_label,event_id
+"Intake",1,intake_arm_1,,12357
+"Dischage",1,dischage_arm_1,,12358
+"Follow up",1,follow_up_arm_1,,12359

inst/test-data/project-longitudinal/event.csv

@@ -0,0 +1,13 @@
+event_name,arm_num,unique_event_name,custom_event_label,event_id
+"Enrollment",1,enrollment_arm_1,,2888
+"Dose 1",1,dose_1_arm_1,,2889
+"Visit 1",1,visit_1_arm_1,,2890
+"Dose 2",1,dose_2_arm_1,,2891
+"Visit 2",1,visit_2_arm_1,,2892
+"Final visit",1,final_visit_arm_1,,2895
+"Enrollment",2,enrollment_arm_2,,2896
+"Deadline to opt out of study",2,deadline_to_opt_ou_arm_2,,2897
+"First dose",2,first_dose_arm_2,,2898
+"First visit",2,first_visit_arm_2,,2899
+"Final visit",2,final_visit_arm_2,,2902
+"Deadline to return feedback",2,deadline_to_return_arm_2,,2903