starting delete for single-arm projects

ref #372

NAMESPACE

@@ -9,6 +9,7 @@ export(constant_to_form_rights)
 export(create_batch_glossary)
 export(create_credential_local)
 export(redcap_column_sanitize)
+export(redcap_delete)
 export(redcap_download_file_oneshot)
 export(redcap_download_instrument)
 export(redcap_metadata_read)

R/project-delete-single-arm.R

@@ -0,0 +1,112 @@
+# These functions are not exported.
+
+populate_project_delete_single_arm <- function() {
+  if (!requireNamespace("testthat")) {
+    # nocov start
+    stop(
+      "The function REDCapR:::populate_project_delete_single_arm() cannot run if the ",
+      "`testthat` package is not installed.  Please install it and try again."
+    )
+    # nocov end
+  }
+
+  credential  <- retrieve_credential_testing(2626L)
+
+  project <- REDCapR::redcap_project$new(
+    redcap_uri    = credential$redcap_uri,
+    token         = credential$token
+  )
+  path_in <- system.file(
+    "test-data/delete-single-arm/delete-single-arm-data.csv",
+    package = "REDCapR"
+  )
+
+  # Write the file to disk (necessary only when you wanted to change the data).  Don't uncomment; just run manually.
+  # returned_object <- redcap_read_oneshot(redcap_uri=uri, token=token, raw_or_label="raw")
+  # utils::write.csv(returned_object$data, file="./inst/test-data/project-delete_single_arm/delete_single_arm-data.csv", row.names=FALSE)
+  # returned_object_metadata <- redcap_metadata_read(redcap_uri=uri, token=token)
+  # utils::write.csv(returned_object_metadata$data, file="./inst/test-data/project-delete_single_arm/delete_single_arm-metadata.csv", row.names=FALSE)
+
+  # Read in the data in R's memory from a csv file.
+  ds_to_write <-
+    readr::read_csv(
+      path_in,
+      show_col_types = FALSE
+    )
+  # ds_to_write <- utils::read.csv(file="./inst/test-data/delete-single-arm/delete-single-arm-data.csv")
+
+  # Import the data into the REDCap project
+  testthat::expect_message(
+    returned_object <- REDCapR::redcap_write(
+      ds          = ds_to_write,
+      redcap_uri  = project$redcap_uri,
+      token       = project$token,
+      verbose     = TRUE
+    )
+  )
+
+  # Print a message and return a boolean value
+  base::message(base::sprintf(
+    "populate_project_delete_single_arm success: %s.",
+    returned_object$success
+  ))
+  list(is_success = returned_object$success, redcap_project = project)
+}
+clear_project_delete_single_arm <- function(verbose = TRUE) {
+  if (!requireNamespace("testthat")) {
+    # nocov start
+    stop(
+      "The function REDCapR:::populate_project_delete_single_arm() cannot run if the ",
+      "`testthat` package is not installed.  Please install it and try again."
+    )
+    # nocov end
+  }
+  path_delete_test_record <-
+    "https://bbmc.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_delete_single_arm.php"
+
+  # Returns a boolean value if successful
+  was_successful <- !httr::http_error(path_delete_test_record)
+
+  # Print a message and return a boolean value
+  if (verbose) {
+    base::message(base::sprintf(
+      "clear_project_delete_single_arm success: %s.",
+      was_successful
+    ))
+  }
+
+  was_successful
+}
+
+clean_start_delete_single_arm <- function(delay_in_seconds = 1) {
+  checkmate::assert_numeric(delay_in_seconds, any.missing=FALSE, len=1, lower=0)
+
+  if (!requireNamespace("testthat")) {
+    # nocov start
+    stop(
+      "The function REDCapR:::populate_project_delete_single_arm() cannot run if the ",
+      "`testthat` package is not installed.  Please install it and try again."
+    )
+    # nocov end
+  }
+  testthat::expect_message(
+    clear_result <- clear_project_delete_single_arm(),
+    regexp = "clear_project_delete_single_arm success: TRUE."
+  )
+  testthat::expect_true(clear_result, "Clearing the results from the delete_single_arm project should be successful.")
+  base::Sys.sleep(delay_in_seconds) #Pause after deleting records.
+
+  testthat::expect_message(
+    populate_result <- populate_project_delete_single_arm(),
+    regexp = "populate_project_delete_single_arm success: TRUE."
+  )
+  testthat::expect_true(populate_result$is_success, "Population of the delete_single_arm project should be successful.")
+  base::Sys.sleep(delay_in_seconds) #Pause after writing records.
+
+  populate_result
+}
+
+# populate_project_delete_single_arm()
+# clear_project_delete_single_arm()
+# clean_start_delete_single_arm()
+# clean_start_delete_single_arm(batch = TRUE)

R/redcap-delete.R

@@ -0,0 +1,130 @@
+#' @title Delete records in a REDCap project
+#'
+#' @description This function uses REDCap's API to delete the specified records.
+#'
+#' @param redcap_uri The URI (uniform resource identifier) of the REDCap
+#' project.  Required.
+#' @param token The user-specific string that serves as the password for a
+#' project.  Required.
+#' @param records_to_delete A character vector of the project's `record_id`
+#' values to delete.  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 to pass to [httr::POST()] method
+#' in the 'httr' package.  See the details in [redcap_read_oneshot()] Optional.
+#'
+#' @return Currently, a list is returned with the following elements:
+#' * `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.
+#' * `records_affected_count`: The number of records inserted or updated.
+#' * `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.
+#'
+#' @details
+#' REDCap requires that at least one `record_id` value be passed to
+#' the delete call.
+#'
+#' @author 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{
+#' #Define some constants
+#' uri            <- "https://bbmc.ouhsc.edu/redcap/api/"
+#' token          <- "D70F9ACD1EDD6F151C6EA78683944E98"
+#'
+#' # Read the dataset for the first time.
+#' result_read1   <- REDCapR::redcap_delete(redcap_uri=uri, token=token)
+#' ds1            <- result_read1$data
+#' ds1$telephone
+#'
+#' }
+
+#' @export
+redcap_delete <- function(
+  redcap_uri,
+  token,
+  records_to_delete,
+  verbose         = TRUE,
+  config_options  = NULL
+) {
+
+  checkmate::assert_character(redcap_uri, any.missing=FALSE, len=1, pattern="^.{1,}$")
+  checkmate::assert_character(token     , any.missing=FALSE, len=1, pattern="^.{1,}$")
+  checkmate::assert_vector(records_to_delete, any.missing = FALSE, min.len = 1)
+
+  token   <- sanitize_token(token)
+  verbose <- verbose_prepare(verbose)
+  records_to_delete <- as.character(records_to_delete)
+  checkmate::assert_character(records_to_delete, any.missing = FALSE, min.len = 1)
+
+  # record_string <-
+  #   sprintf(
+  #     "'records[%i]': '%s'",
+  #     seq_along(records_to_delete) - 1,
+  #     records_to_delete
+  #   ) #%>%
+  #   # paste(collapse = ",")
+  records_to_delete <-
+    stats::setNames(
+      records_to_delete,
+      sprintf("records[%i]", seq_along(records_to_delete) - 1)
+    )
+
+  post_body <- c(
+    list(
+      token     = token,
+      content   = "record",
+      action    = "delete"
+    ),
+    records_to_delete
+  )
+
+  # This is the important line that communicates with the REDCap server.
+  kernel <- kernel_api(redcap_uri, post_body, config_options)
+
+  if (kernel$success) {
+    records_affected_count <- as.integer(kernel$raw_text)
+    outcome_message        <- sprintf(
+      "%s records were deleted from REDCap in %0.1f seconds.",
+      format(records_affected_count, big.mark = ",", scientific = FALSE, trim = TRUE),
+      kernel$elapsed_seconds
+    )
+
+    #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 the returned content wasn't recognized as valid IDs, then
+    records_affected_count <- 0
+    outcome_message        <- sprintf(
+      "The REDCapR delete operation was not successful.  The error message was:\n%s",
+      kernel$raw_text
+    )
+  }
+
+  if (verbose)
+    message(outcome_message)
+
+  list(
+    success                   = kernel$success,
+    status_code               = kernel$status_code,
+    outcome_message           = outcome_message,
+    records_affected_count    = records_affected_count,
+    elapsed_seconds           = kernel$elapsed_seconds,
+    raw_text                  = kernel$raw_text
+  )
+}

inst/misc/example.credentials

@@ -25,3 +25,5 @@ redcap_uri,username,project_id,token,comment
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","2593","1C31398F332FCACA4C0A7B93B18D5CD4","super-wide #2--5,785 columns"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","2597","5C1526186C4D04AE0A0630743E69B53C","super-wide #3--35,000 columns"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","2603","56F43A10D01D6578A46393394D76D88F","Repeating Instruments --Sparse"
+"https://bbmc.ouhsc.edu/redcap/api/","myusername","2626","7422A8DBB6DF0AE1EDE185CF5A236992","Delete Single Arm"
+"https://bbmc.ouhsc.edu/redcap/api/","myusername","2627","CDF9F3767E413FDBAA31D92E9F36730A","Delete Multiple Arm"

inst/test-data/delete-single-arm/delete-single-arm-data.csv

@@ -0,0 +1,21 @@
+record_id,birth_date,position,demographics_complete
+101,2020-05-01,pg,2
+102,2020-06-01,sg,2
+103,2020-07-01,sf,2
+104,2020-08-01,pf,2
+105,2020-09-01,c,2
+106,2020-10-01,pg,2
+107,2020-11-01,sg,2
+108,2020-12-01,sf,2
+109,2021-01-01,pf,2
+110,2021-02-01,c,2
+111,2021-03-01,pg,2
+112,2021-04-01,sg,2
+113,2021-05-01,sf,2
+114,2021-06-01,pf,2
+115,2021-07-01,c,2
+116,2021-08-01,pg,2
+117,2021-09-01,sg,2
+118,2021-10-01,sf,2
+119,2021-11-01,pf,2
+120,2021-12-01,c,2

inst/test-data/specific-redcapr/delete/single-arm-four-records.R

@@ -0,0 +1,7 @@
+structure(list(record_id = c(101, 104, 106, 107, 108, 109, 110, 
+111, 112, 113, 114, 115, 116, 117, 118, 119), birth_date = structure(c(18383, 
+18475, 18536, 18567, 18597, 18628, 18659, 18687, 18718, 18748, 
+18779, 18809, 18840, 18871, 18901, 18932), class = "Date"), position = c("pg", 
+"pf", "pg", "sg", "sf", "pf", "c", "pg", "sg", "sf", "pf", "c", 
+"pg", "sg", "sf", "pf"), demographics_complete = c(2, 2, 2, 2, 
+2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)), row.names = c(NA, -16L), class = "data.frame")