OuhscBbmc / REDCapR

@@ -0,0 +1,200 @@
Loading
1 +
#' @title Get the logging of a project.
2 +
#'
3 +
#' @description This function reads the available logging messages 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 log_begin_date Return the events occurring after midnight of this
11 +
#' date.
12 +
#' Defaults to the past week; this default mimics the behavior in the browser
13 +
#' and also reduces the strain on your server.
14 +
#' @param log_end_date Return the events occurring before 24:00 of this date.
15 +
#' Defaults to today.
16 +
#' @param record Return the events belonging only to specific record
17 +
#' (referring to an existing record name).
18 +
#' Defaults to `NULL` which returns
19 +
#' logging activity related to all records.
20 +
#' If a record value passed, it must be a single value.
21 +
#' @param user Return the events belonging only to specific user
22 +
#' (referring to an existing username).
23 +
#' Defaults to `NULL` which returns
24 +
#' logging activity related to all users.
25 +
#' If a user value passed, it must be a single value.
26 +
#' @param http_response_encoding  The encoding value passed to
27 +
#' [httr::content()].  Defaults to 'UTF-8'.
28 +
#' @param locale a [readr::locale()] object to specify preferences like
29 +
#' number, date, and time formats.  This object is passed to
30 +
#' [`readr::read_csv()`].  Defaults to [readr::default_locale()].
31 +
#' @param verbose A boolean value indicating if `message`s should be printed
32 +
#' to the R console during the operation.  The verbose output might contain
33 +
#' sensitive information (*e.g.* PHI), so turn this off if the output might
34 +
#' be visible somewhere public. Optional.
35 +
#' @param config_options  A list of options to pass to `POST` method in the
36 +
#' `httr` package.
37 +
#'
38 +
#' @return Currently, a list is returned with the following elements:
39 +
#' * `data`: An R [base::data.frame()] of all data access groups of the project.
40 +
#' * `success`: A boolean value indicating if the operation was apparently
41 +
#' successful.
42 +
#' * `status_codes`: A collection of
43 +
#' [http status codes](https://en.wikipedia.org/wiki/List_of_HTTP_status_codes),
44 +
#' separated by semicolons.  There is one code for each batch attempted.
45 +
#' * `outcome_messages`: A collection of human readable strings indicating the
46 +
#' operations' semicolons.  There is one code for each batch attempted.  In an
47 +
#' unsuccessful operation, it should contain diagnostic information.
48 +
#' * `elapsed_seconds`: The duration of the function.
49 +
#'
50 +
#' @author Jonathan M. Mang, Will Beasley
51 +
#' @references The official documentation can be found on the 'API Help Page'
52 +
#' and 'API Examples' pages on the REDCap wiki (*i.e.*,
53 +
#' https://community.projectredcap.org/articles/456/api-documentation.html
54 +
#' and
55 +
#' https://community.projectredcap.org/articles/462/api-examples.html).
56 +
#' If you do not have an account for the wiki, please ask your campus REDCap
57 +
#' administrator to send you the static material.
58 +
#'
59 +
#' @examples
60 +
#' \dontrun{
61 +
#' uri          <- "https://bbmc.ouhsc.edu/redcap/api/"
62 +
#' token        <- "9A81268476645C4E5F03428B8AC3AA7B"
63 +
#'
64 +
#' ds_last_week <- REDCapR::redcap_log_read(redcap_uri=uri, token=token)$data
65 +
#' head(ds_last_week)
66 +
#'
67 +
#' ds_one_day <-
68 +
#'   REDCapR::redcap_log_read(
69 +
#'     redcap_uri     = uri,
70 +
#'     token          = token,
71 +
#'     log_begin_date = as.Date("2020-08-10"),
72 +
#'     log_end_date   = as.Date("2020-08-10")
73 +
#'   )$data
74 +
#' head(ds_one_day)
75 +
#'
76 +
#' ds_one_day_single_record_single_user <-
77 +
#'   REDCapR::redcap_log_read(
78 +
#'     redcap_uri     = uri,
79 +
#'     token          = token,
80 +
#'     log_begin_date = as.Date("2021-07-11"),
81 +
#'     log_end_date   = as.Date("2021-07-11"),
82 +
#'     record         = as.character(3),
83 +
#'     user           = "unittestphifree"
84 +
#'   )$data
85 +
#' head(ds_one_day_single_record_single_user)
86 +
#' }
87 +
88 +
#' @export
89 +
redcap_log_read <- function(
90 +
  redcap_uri,
91 +
  token,
92 +
  log_begin_date                = Sys.Date() - 7L,
93 +
  log_end_date                  = Sys.Date(),
94 +
  record                        = NULL,
95 +
  user                          = NULL,
96 +
  http_response_encoding        = "UTF-8",
97 +
  locale                        = readr::default_locale(),
98 +
  verbose                       = TRUE,
99 +
  config_options                = NULL
100 +
) {
101 +
  checkmate::assert_character(redcap_uri                , any.missing = FALSE, len = 1, pattern = "^.{1,}$")
102 +
  checkmate::assert_character(token                     , any.missing = FALSE, len = 1, pattern = "^.{1,}$")
103 +
  checkmate::assert_date(     log_begin_date            , any.missing = FALSE, len = 1)
104 +
  checkmate::assert_date(     log_end_date              , any.missing = FALSE, len = 1)
105 +
  checkmate::assert_character(record                    , any.missing = FALSE, len = 1, null.ok = TRUE)
106 +
  checkmate::assert_character(user                      , any.missing = FALSE, len = 1, null.ok = TRUE)
107 +
108 +
  checkmate::assert_character(http_response_encoding    , any.missing=FALSE,   len = 1)
109 +
  checkmate::assert_class(    locale, classes = "locale", null.ok = FALSE)
110 +
  checkmate::assert_logical(  verbose                   , any.missing=FALSE,   len = 1, null.ok = TRUE)
111 +
  checkmate::assert_list(     config_options            , any.missing=TRUE ,            null.ok = TRUE)
112 +
113 +
  token               <- sanitize_token(token)
114 +
  verbose             <- verbose_prepare(verbose)
115 +
  log_begin_datetime  <- strftime(log_begin_date    , "%Y-%m-%d 00:00")
116 +
  log_end_datetime    <- strftime(log_end_date      , "%Y-%m-%d 24:00")
117 +
118 +
  post_body <- list(
119 +
    token                   = token,
120 +
    content                 = "log",
121 +
    format                  = "csv",
122 +
    beginTime               = log_begin_datetime,
123 +
    endTime                 = log_end_datetime,
124 +
    record                  = record,
125 +
    user                    = user
126 +
  )
127 +
128 +
  # This is the important line that communicates with the REDCap server.
129 +
  kernel <- kernel_api(
130 +
    redcap_uri      = redcap_uri,
131 +
    post_body       = post_body,
132 +
    config_options  = config_options,
133 +
    encoding        = http_response_encoding
134 +
  )
135 +
136 +
  if (kernel$success) {
137 +
    try(
138 +
      # Convert the raw text to a dataset.
139 +
      ds <-
140 +
        readr::read_csv(
141 +
          file            = I(kernel$raw_text),
142 +
          locale          = locale,
143 +
          show_col_types  = FALSE
144 +
        ) %>%
145 +
        as.data.frame(),
146 +
147 +
      # Don't print the warning in the try block.  Print it below,
148 +
      #   where it's under the control of the caller.
149 +
      silent = TRUE
150 +
    )
151 +
152 +
    if (exists("ds") & inherits(ds, "data.frame")) {
153 +
      outcome_message <- sprintf(
154 +
        "%s rows were read from REDCap in %0.1f seconds.  The http status code was %i.",
155 +
        format(  nrow(ds), big.mark = ",", scientific = FALSE, trim = TRUE),
156 +
        kernel$elapsed_seconds,
157 +
        kernel$status_code
158 +
      )
159 +
160 +
      # If an operation is successful, the `raw_text` is no longer returned to
161 +
      #   save RAM.  The content is not really necessary with httr's status
162 +
      #   message exposed.
163 +
      kernel$raw_text   <- ""
164 +
    } else { # ds doesn't exist as a data.frame.
165 +
      # nocov start
166 +
      # Override the 'success' determination from the http status code.
167 +
      #   and return an empty data.frame.
168 +
      kernel$success   <- FALSE
169 +
      ds               <- data.frame()
170 +
      outcome_message  <- sprintf(
171 +
        "The REDCap log export failed.  The http status code was %i.  The 'raw_text' returned was '%s'.",
172 +
        kernel$status_code,
173 +
        kernel$raw_text
174 +
      )
175 +
      # nocov end
176 +
    }
177 +
  } else { # kernel fails
178 +
    ds              <- data.frame() #Return an empty data.frame
179 +
    outcome_message <- if (any(grepl(kernel$regex_empty, kernel$raw_text))) {
180 +
      "The REDCapR log export operation was not successful.  The returned dataset was empty."  # nocov
181 +
    } else {
182 +
      sprintf(
183 +
        "The REDCapR log export operation was not successful.  The error message was:\n%s",
184 +
        kernel$raw_text
185 +
      )
186 +
    }
187 +
  }
188 +
189 +
  if (verbose)
190 +
    message(outcome_message)
191 +
192 +
  list(
193 +
    data               = ds,
194 +
    success            = kernel$success,
195 +
    status_code        = kernel$status_code,
196 +
    outcome_message    = outcome_message,
197 +
    elapsed_seconds    = kernel$elapsed_seconds,
198 +
    raw_text           = kernel$raw_text
199 +
  )
200 +
}
Files Coverage
R 95.77%
Project Totals (38 files) 95.77%
1
comment: false
2

3
coverage:
4
  status:
5
    project:
6
      default:
7
        target: auto
8
        threshold: 3%
9
    patch:
10
      default:
11
        target: auto
12
        threshold: 3%
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading