R/exportDataQuality.R

In nutterb/redcapAPI: Interface to 'REDCap'

#####################################################################
# exportDataQuality                                              ####

#' @name exportDataQuality
#' @title A helper function to export data queries from the Data Quality REDCap
#'   module.
#' @description Exports Data Quality queries by record. The Data Quality module 
#'   must be enabled on the Control Center of REDCap to use this function. Additionally, 
#'   this module must be enabled on each project before it can be used.
#'
#' @param rcon  A REDCap connection object as generated by `redcapConnection`.
#' @param prefix A string from your REDCap institutions Data Quality module url. The 
#'   module prefix can be found by exporting module settings under External Modules
#'   in REDCap. At VUMC the prefix is 'vanderbilt_dataQuality'.
#' @param ..., additional arguments that are ignored.

#' @export
exportDataQuality <- function(rcon, prefix, ...)
  UseMethod("exportDataQuality")

#' @export
exportDataQuality.redcapApiConnection <-
  function(rcon,
           prefix,
           ...)
{
  ###################################################################
  # Argument Validation                                          ####
  
  coll <- checkmate::makeAssertCollection()
  
  checkmate::assert_class(x = rcon, 
                          classes = "redcapApiConnection", 
                          add = coll)
  
  checkmate::assert_class(x = prefix, 
                          classes = "character", 
                          add = coll)

  checkmate::reportAssertions(coll)
  
  ###################################################################
  # Build the query list                                         ####
  
  url <- paste0(rcon$url,
                "?prefix=",
                prefix,
                "&page=export&type=module&NOAUTH&pid=",
                rcon$projectInformation()$project_id)
  
  response <- makeApiCall(rcon, url=url, ...)

  tryCatch(
  {
    result <- .curlContent(response, type = 'application/json')
  },
  error = function(e)
  {
    stop("Make sure the Data Quality API module is enabled in your project.")
  })
  
  .makeDq(result)
}

.listSwapNullToNa <- function(x) {
  size <- vapply(x, length, numeric(1))
  nr <- max(size)
  na_vals <- rep(NA, nr)
  for(j in which(size == 0)) x[[j]] <- na_vals
  x
}

.makeDq <- function(result) {
  empty_dq <- data.frame(
    status_id = NA,
    rule_id = NA,
    pd_rule_id = NA,
    non_rule = NA,
    project_id = NA,
    record = NA,
    event_id = NA,
    field_name = NA,
    repeat_instrument = NA,
    instance = NA,
    status = NA,
    exclude = NA,
    query_status = NA,
    group_id = NA,
    assigned_username = NA
  )[FALSE,]
  empty_res <- data.frame(
    res_id = NA,
    status_id = NA,
    ts = NA,
    response_requested = NA,
    response = NA,
    comment = NA,
    current_query_status = NA,
    upload_doc_id = NA,
    field_comment_edited = NA,
    username = NA
  )[FALSE,]
  
  dq_info <- vector('list', length(result))
  res_info <- vector('list', length(result))
  for(i in seq_along(result)) {
    tmp <- result[[i]]
    res_i <- lapply(tmp$resolutions, function(i) {
      as.data.frame(.listSwapNullToNa(i))
    })
    res_ii <- do.call(rbind, res_i)
    if(is.null(res_ii) || nrow(res_ii) == 0) res_ii <- empty_res
    res_info[[i]] <- res_ii
    tmp$resolutions <- NULL
    dq_ii <- as.data.frame(.listSwapNullToNa(tmp))
    if(nrow(dq_ii) == 0) dq_ii <- empty_dq
    dq_info[[i]] <- dq_ii
  }
  dq_dat <- do.call(rbind, dq_info)
  res_dat <- do.call(rbind, res_info)
  if(nrow(dq_dat) == 0) dq_dat <- empty_dq
  merge(dq_dat, res_dat, all.x = TRUE)
}