|
| 1 | +#' @title Read data access groups from a REDCap project |
| 2 | +#' |
| 3 | +#' @description This function reads all available data access groups from |
| 4 | +#' REDCap an returns them as a [base::data.frame()]. |
| 5 | +#' |
| 6 | +#' @param redcap_uri The URI (uniform resource identifier) of the REDCap |
| 7 | +#' project. Required. |
| 8 | +#' @param token The user-specific string that serves as the password for a |
| 9 | +#' project. Required. |
| 10 | +#' @param http_response_encoding The encoding value passed to |
| 11 | +#' [httr::content()]. Defaults to 'UTF-8'. |
| 12 | +#' @param locale a [readr::locale()] object to specify preferences like |
| 13 | +#' number, date, and time formats. This object is passed to |
| 14 | +#' [`readr::read_csv()`]. Defaults to [readr::default_locale()]. |
| 15 | +#' @param verbose A boolean value indicating if `message`s should be printed |
| 16 | +#' to the R console during the operation. The verbose output might contain |
| 17 | +#' sensitive information (*e.g.* PHI), so turn this off if the output might |
| 18 | +#' be visible somewhere public. Optional. |
| 19 | +#' @param config_options A list of options to pass to `POST` method in the |
| 20 | +#' `httr` package. |
| 21 | +#' |
| 22 | +#' @return Currently, a list is returned with the following elements: |
| 23 | +#' * `data`: An R [base::data.frame()] of all data access groups of the project. |
| 24 | +#' * `success`: A boolean value indicating if the operation was apparently |
| 25 | +#' successful. |
| 26 | +#' * `status_codes`: A collection of |
| 27 | +#' [http status codes](https://en.wikipedia.org/wiki/List_of_HTTP_status_codes), |
| 28 | +#' separated by semicolons. There is one code for each batch attempted. |
| 29 | +#' * `outcome_messages`: A collection of human readable strings indicating the |
| 30 | +#' operations' semicolons. There is one code for each batch attempted. In an |
| 31 | +#' unsuccessful operation, it should contain diagnostic information. |
| 32 | +#' * `elapsed_seconds`: The duration of the function. |
| 33 | +#' |
| 34 | +#' |
| 35 | +#' @author Jonathan M. Mang |
| 36 | +#' @references The official documentation can be found on the 'API Help Page' |
| 37 | +#' and 'API Examples' pages on the REDCap wiki (*i.e.*, |
| 38 | +#' https://community.projectredcap.org/articles/456/api-documentation.html |
| 39 | +#' and |
| 40 | +#' https://community.projectredcap.org/articles/462/api-examples.html). |
| 41 | +#' If you do not have an account for the wiki, please ask your campus REDCap |
| 42 | +#' administrator to send you the static material. |
| 43 | +#' |
| 44 | +#' @examples |
| 45 | +#' \dontrun{ |
| 46 | +#' uri <- "https://bbmc.ouhsc.edu/redcap/api/" |
| 47 | +#' token <- "9A81268476645C4E5F03428B8AC3AA7B" |
| 48 | +#' REDCapR::redcap_dag_read(redcap_uri=uri, token=token)$data |
| 49 | +#' } |
| 50 | + |
| 51 | +#' @export |
| 52 | +redcap_dag_read <- function( |
| 53 | + redcap_uri, |
| 54 | + token, |
| 55 | + http_response_encoding = "UTF-8", |
| 56 | + locale = readr::default_locale(), |
| 57 | + verbose = TRUE, |
| 58 | + config_options = NULL |
| 59 | +) { |
| 60 | + checkmate::assert_character(redcap_uri , any.missing=FALSE, len=1, pattern="^.{1,}$") |
| 61 | + checkmate::assert_character(token , any.missing=FALSE, len=1, pattern="^.{1,}$") |
| 62 | + checkmate::assert_character(http_response_encoding , any.missing=FALSE, len=1) |
| 63 | + checkmate::assert_class( locale, "locale" , null.ok = FALSE) |
| 64 | + |
| 65 | + checkmate::assert_logical( verbose , any.missing=FALSE, len=1, null.ok=TRUE) |
| 66 | + checkmate::assert_list( config_options , any.missing=TRUE , null.ok=TRUE) |
| 67 | + |
| 68 | + |
| 69 | + token <- sanitize_token(token) |
| 70 | + verbose <- verbose_prepare(verbose) |
| 71 | + |
| 72 | + post_body <- list( |
| 73 | + token = token, |
| 74 | + content = "dag", |
| 75 | + format = "csv" |
| 76 | + ) |
| 77 | + |
| 78 | + # This is the important line that communicates with the REDCap server. |
| 79 | + kernel <- kernel_api( |
| 80 | + redcap_uri = redcap_uri, |
| 81 | + post_body = post_body, |
| 82 | + config_options = config_options, |
| 83 | + encoding = http_response_encoding |
| 84 | + ) |
| 85 | + |
| 86 | + if (kernel$success) { |
| 87 | + try( |
| 88 | + # Convert the raw text to a dataset. |
| 89 | + ds <- |
| 90 | + readr::read_csv( |
| 91 | + file = I(kernel$raw_text), |
| 92 | + locale = locale, |
| 93 | + show_col_types = FALSE |
| 94 | + ) %>% |
| 95 | + as.data.frame(), |
| 96 | + |
| 97 | + # Don't print the warning in the try block. Print it below, |
| 98 | + # where it's under the control of the caller. |
| 99 | + silent = TRUE |
| 100 | + ) |
| 101 | + |
| 102 | + if (exists("ds") & inherits(ds, "data.frame")) { |
| 103 | + outcome_message <- sprintf( |
| 104 | + "%s data access groups were read from REDCap in %0.1f seconds. The http status code was %i.", |
| 105 | + format( nrow(ds), big.mark = ",", scientific = FALSE, trim = TRUE), |
| 106 | + kernel$elapsed_seconds, |
| 107 | + kernel$status_code |
| 108 | + ) |
| 109 | + |
| 110 | + # ds <- dplyr::mutate_if( |
| 111 | + # ds, |
| 112 | + # is.character, |
| 113 | + # function(x) dplyr::coalesce(x, "") #Replace NAs with blanks |
| 114 | + # ) |
| 115 | + # |
| 116 | + # ds <- dplyr::mutate_if( |
| 117 | + # ds, |
| 118 | + # is.character, |
| 119 | + # function( x ) gsub("\r\n", "\n", x, perl=TRUE) |
| 120 | + # ) |
| 121 | + # ds <- dplyr::mutate_if( |
| 122 | + # ds, |
| 123 | + # function( x) inherits(x, "Date"), |
| 124 | + # as.character |
| 125 | + # ) |
| 126 | + # |
| 127 | + # ds <- base::as.data.frame(ds) |
| 128 | + |
| 129 | + # If an operation is successful, the `raw_text` is no longer returned to |
| 130 | + # save RAM. The content is not really necessary with httr's status |
| 131 | + # message exposed. |
| 132 | + kernel$raw_text <- "" |
| 133 | + } else { # ds doesn't exist as a data.frame. |
| 134 | + # nocov start |
| 135 | + # Override the 'success' determination from the http status code. |
| 136 | + # and return an empty data.frame. |
| 137 | + kernel$success <- FALSE |
| 138 | + ds <- data.frame() |
| 139 | + outcome_message <- sprintf( |
| 140 | + "The REDCap read failed. The http status code was %i. The 'raw_text' returned was '%s'.", |
| 141 | + kernel$status_code, |
| 142 | + kernel$raw_text |
| 143 | + ) |
| 144 | + # nocov end |
| 145 | + } |
| 146 | + } else { # kernel fails |
| 147 | + ds <- data.frame() #Return an empty data.frame |
| 148 | + outcome_message <- if (any(grepl(kernel$regex_empty, kernel$raw_text))) { |
| 149 | + "The REDCapR read/export operation was not successful. The returned dataset was empty." # nocov |
| 150 | + } else { |
| 151 | + sprintf( |
| 152 | + "The REDCapR read/export operation was not successful. The error message was:\n%s", |
| 153 | + kernel$raw_text |
| 154 | + ) |
| 155 | + } |
| 156 | + } |
| 157 | + |
| 158 | + if (verbose) |
| 159 | + message(outcome_message) |
| 160 | + |
| 161 | + list( |
| 162 | + data = ds, |
| 163 | + success = kernel$success, |
| 164 | + status_code = kernel$status_code, |
| 165 | + outcome_message = outcome_message, |
| 166 | + elapsed_seconds = kernel$elapsed_seconds, |
| 167 | + raw_text = kernel$raw_text |
| 168 | + ) |
| 169 | +} |
0 commit comments