R/exportRecordsTyped.R

Defines functions exportBulkRecords .exportRecordsTyped_Batched .exportRecordsTyped_Unbatched .exportRecordsTyped_fieldsArray .exportRecordsTyped_validateFieldForm .exportRecordsTyped_validateCommonArgument exportRecordsTyped.redcapOfflineConnection exportRecordsTyped.redcapApiConnection exportRecordsTyped

Documented in exportBulkRecords exportRecordsTyped exportRecordsTyped.redcapApiConnection exportRecordsTyped.redcapOfflineConnection

#' @describeIn recordsTypedMethods Export records with type casting.
#' @order 1
#' @export

exportRecordsTyped <-
  function(
    # API Call parameters
    rcon,

    # Limiters
    fields        = NULL,
    drop_fields   = NULL,
    forms         = NULL,
    records       = NULL,
    events        = NULL,
    # Removed arguments that cannot be used in the offline function
    ...)
    
    UseMethod("exportRecordsTyped")

#' @rdname recordsTypedMethods
#' @order 3
#' @export

exportRecordsTyped.redcapApiConnection <- 
  function(
    # API Call parameters
    rcon,  
    
    # Limiters
    fields         = NULL,
    drop_fields    = NULL,
    forms          = NULL,
    records        = NULL,
    events         = NULL,
    survey         = TRUE,
    dag            = TRUE,
    date_begin     = NULL,
    date_end       = NULL,
    
    # Type Casting Default Overrides Function Lists
    na             = list(),
    validation     = list(),
    cast           = list(),
    assignment     = list(label=stripHTMLandUnicode,
                          units=unitsFieldAnnotation),
    filter_empty_rows = TRUE,
    ...,
    config         = list(),
    api_param      = list(),
    csv_delimiter  = ",",
    batch_size     = NULL, 
    error_handling = getOption("redcap_error_handling"))
{
  if (is.numeric(records)) records <- as.character(records)

   ###########################################################################
  # Check parameters passed to function
  coll <- checkmate::makeAssertCollection()

  checkmate::assert_class(x = rcon,
                          classes = "redcapApiConnection",
                          add = coll)
  
  .exportRecordsTyped_validateCommonArgument(fields      = fields,
                                             drop_fields = drop_fields,
                                             forms       = forms,
                                             records     = records,
                                             events      = events, 
                                             na          = na, 
                                             validation  = validation, 
                                             cast        = cast, 
                                             assignment  = assignment,
                                             coll        = coll)
  
  checkmate::assert_logical(x = survey, 
                            len = 1, 
                            any.missing = FALSE,
                            add = coll)
  
  checkmate::assert_logical(x = dag, 
                            len = 1, 
                            any.missing = FALSE,
                            add = coll)
  
  checkmate::assert_posixct(x = date_begin, 
                            max.len = 1, 
                            any.missing = FALSE,
                            null.ok = TRUE, 
                            add = coll)
  
  checkmate::assert_posixct(x = date_end, 
                            max.len = 1, 
                            any.missing = FALSE,
                            null.ok = TRUE, 
                            add = coll)
  
  checkmate::assert_integerish(x = batch_size,
                               lower = 1, 
                               max.len = 1, 
                               any.missing = FALSE,
                               null.ok = TRUE, 
                               add = coll)
  
  csv_delimiter <- checkmate::matchArg(x         = csv_delimiter, 
                                       choices   = c(",", "\t", ";", "|", "^"),
                                       .var.name = "csv_delimiter",
                                       add = coll)
  
  checkmate::assert_list(x = config, 
                         names = "named", 
                         add = coll)
  
  checkmate::assert_list(x = api_param, 
                         names = "named", 
                         add = coll)
  
  checkmate::assert_logical(x = filter_empty_rows, 
                            len = 1, 
                            any.missing = FALSE,
                            add = coll)

  checkmate::reportAssertions(coll)
  
  .exportRecordsTyped_validateFieldForm(rcon = rcon, 
                                        fields = fields, 
                                        drop_fields = drop_fields, 
                                        forms = forms, 
                                        coll = coll)
  
  ###################################################################
  # Handle System Fields in the Request
  
  user_requested_system_fields <- length(fields) > 0 && any(fields %in% REDCAP_SYSTEM_FIELDS)
  user_requested_only_system_fields <- length(fields) > 0 && all(fields %in% REDCAP_SYSTEM_FIELDS)
  system_fields_user_requested <- REDCAP_SYSTEM_FIELDS[REDCAP_SYSTEM_FIELDS %in% fields]
  
  # The REDCap API will not accept system fields in the fields argument. 
  # we have to remove them from the request.
  fields <- fields[!fields %in% REDCAP_SYSTEM_FIELDS] # redcapDataStructures.R
  
  # But if the user only requested system fields, we need to provide 
  # at least one actual field to get anything back from the API
  if (user_requested_only_system_fields){
    fields <- rcon$metadata()$field_name[1]
  }
  
  # Check that the events exist in the project
  
  checkmate::assert_subset(x = events, 
                           choices = rcon$events()$unique_event_name, 
                           add = coll)
  
  checkmate::reportAssertions(coll)
  
   ###################################################################
  # Combine fields, drop_fields, and forms into the fields that will 
  # be exported
  fields <- .exportRecordsTyped_fieldsArray(rcon        = rcon, 
                                            fields      = fields, 
                                            drop_fields = drop_fields, 
                                            forms       = forms)
  
   ###################################################################
  # Call API for Raw Results
  
  # We do not need to pass forms to the API because we have 
  # absorbed that information directly into fields
  body <- c(list(content                = "record", 
                 format                 = "csv", 
                 returnFormat           = "csv", 
                 type                   = "flat", 
                 exportSurveyFields     = tolower(survey), 
                 exportDataAccessGroups = tolower(dag), 
                 dateRangeBegin         = format(date_begin, format = "%Y-%m-%d %H:%M:S"), 
                 dateRangeEnd           = format(date_end,   format = "%Y-%m-%d %H:M%:%S"), 
                 csvDelimiter           = csv_delimiter), 
            vectorToApiBodyList(fields, "fields"), 
            vectorToApiBodyList(events, "events"))
  
  body <- body[lengths(body) > 0]
  
  Raw <- 
    if (length(batch_size) == 0)
    {
      .exportRecordsTyped_Unbatched( rcon           = rcon, 
                                     body           = body, 
                                     records        = records, 
                                     config         = config, 
                                     api_param      = api_param, 
                                     csv_delimiter  = csv_delimiter, 
                                     error_handling = error_handling)
    } else
    {
      .exportRecordsTyped_Batched(  rcon           = rcon, 
                                    body           = body, 
                                    records        = records, 
                                    config         = config, 
                                    api_param      = api_param, 
                                    csv_delimiter  = csv_delimiter, 
                                    batch_size     = batch_size, 
                                    error_handling = error_handling)
    }
  
  if (identical(Raw, data.frame())){
    return(Raw)
  }
  
  if(filter_empty_rows) Raw <- filterEmptyRow(Raw, rcon)
  
  if (user_requested_system_fields){
    if (user_requested_only_system_fields){
      Raw <- Raw[-1]
    }
    
    unrequested_fields <- REDCAP_SYSTEM_FIELDS[!REDCAP_SYSTEM_FIELDS %in% system_fields_user_requested]
    Raw <- Raw[!names(Raw) %in% unrequested_fields]
  }
  
  # See fieldCastingFunctions.R for definition of .castRecords
  .castRecords(Raw              = Raw, 
               Records          = NULL,
               rcon             = rcon, 
               na               = na, 
               validation       = validation, 
               cast             = cast, 
               assignment       = assignment, 
               default_cast     = .default_cast, 
               default_validate = .default_validate)
}



#' @describeIn recordsTypedMethods Export records without API access.
#' @order 4
#' @export

exportRecordsTyped.redcapOfflineConnection <- function(rcon, 
                                                       fields        = NULL,
                                                       drop_fields   = NULL,
                                                       forms         = NULL,
                                                       records       = NULL,
                                                       events        = NULL,
                                                       
                                                       # Type Casting Default Overrides Function Lists
                                                       na            = list(),
                                                       validation    = list(),
                                                       cast          = list(),
                                                       assignment    = list(label=stripHTMLandUnicode,
                                                                            units=unitsFieldAnnotation),
                                                       ...){
  
  if (is.numeric(records)) records <- as.character(records)
  
  ###################################################################
  # Argument Validation
  
  coll <- checkmate::makeAssertCollection()
  
  checkmate::assert_class(x = rcon, 
                          classes = "redcapOfflineConnection", 
                          add = coll)
  
  .exportRecordsTyped_validateCommonArgument(fields = fields, 
                                             drop_fields = drop_fields, 
                                             forms = forms, 
                                             records = records, 
                                             events = events, 
                                             na          = na, 
                                             validation  = validation, 
                                             cast        = cast, 
                                             assignment  = assignment,
                                             coll = coll)
  
  checkmate::reportAssertions(coll)
  
  checkmate::assert_data_frame(x = rcon$metadata(),
                               .var.name = "rcon$metadata()",
                               add = coll)
  
  checkmate::assert_data_frame(x = rcon$record(),
                               .var.name = "rcon$record()",
                               add = coll)
  
  checkmate::reportAssertions(coll)
  
  .exportRecordsTyped_validateFieldForm(rcon = rcon, 
                                        fields = fields, 
                                        drop_fields = drop_fields, 
                                        forms = forms, 
                                        coll = coll)
  
  checkmate::reportAssertions(coll)
  
  ###################################################################
  # Handle System Fields in the Request
  
  user_requested_system_fields <- length(fields) > 0 && any(fields %in% REDCAP_SYSTEM_FIELDS)
  user_requested_only_system_fields <- length(fields) > 0 && all(fields %in% REDCAP_SYSTEM_FIELDS)
  system_fields_user_requested <- REDCAP_SYSTEM_FIELDS[REDCAP_SYSTEM_FIELDS %in% fields]
  
  # The REDCap API will not accept system fields in the fields argument. 
  # we have to remove them from the request.
  fields <- fields[!fields %in% REDCAP_SYSTEM_FIELDS] # redcapDataStructures.R
  
  # But if the user only requested system fields, we need to provide 
  # at least one actual field to get anything back from the API
  if (user_requested_only_system_fields){
    fields <- rcon$metadata()$field_name[1]
  }
  
  ###################################################################
  # Combine fields, drop_fields, and forms into the fields that will 
  # be exported
  
  MetaData <- rcon$metadata()
  
  system_field <- REDCAP_SYSTEM_FIELDS[REDCAP_SYSTEM_FIELDS %in% names(rcon$records())]
  
  fields <- .exportRecordsTyped_fieldsArray(rcon         = rcon, 
                                            fields       = fields, 
                                            drop_fields  = drop_fields, 
                                            forms        = forms, 
                                            use_original = FALSE)
  
  fields <- fields[!fields %in% MetaData$field_name[MetaData$field_type == "descriptive"]]
  
  
  id_index <- which(fields == MetaData$field_name[1])
  
  if (length(id_index) > 0){
    fields <- c(fields[id_index], 
                system_field, 
                fields[-id_index])
  } else {
    fields <- c(system_field, 
                fields)
  }

  ###################################################################
  # Raw Data comes from the rcon object for offlineConnections
  
  Raw <- rcon$records()[fields]
  
  if (length(records) > 0)
    Raw <- Raw[Raw[[ rcon$metadata()$field_name[1] ]] %in% records, ]

  
  if (length(events) > 0)
    Raw <- Raw[Raw$redcap_event_name %in% events, ]
  
  
  if (user_requested_system_fields){
    if (user_requested_only_system_fields){
      Raw <- Raw[-1]
    }
    
    unrequested_fields <- REDCAP_SYSTEM_FIELDS[!REDCAP_SYSTEM_FIELDS %in% system_fields_user_requested]
    Raw <- Raw[!names(Raw) %in% unrequested_fields]
  }
  
  Raw <- filterEmptyRow(Raw, rcon)
  
  ###################################################################
  # Process meta data for useful information
  
  # See fieldCastingFunctions.R for definition of .castRecords
  .castRecords(Raw              = Raw, 
               Records          = NULL,
               rcon             = rcon, 
               na               = na, 
               validation       = validation, 
               cast             = cast, 
               assignment       = assignment, 
               default_cast     = .default_cast, 
               default_validate = .default_validate)
}


#######################################################################
# Unexported

# .exportRecordsTyped_validateCommonArgument ------------------------

.exportRecordsTyped_validateCommonArgument <- function(fields,
                                                       drop_fields,
                                                       forms,
                                                       records,
                                                       events,
                                                       na, 
                                                       validation, 
                                                       cast, 
                                                       assignment,
                                                       coll){
  checkmate::assert_character(x = fields, 
                              any.missing = FALSE, 
                              null.ok = TRUE,
                              add = coll)
  
  checkmate::assert_character(x = drop_fields, 
                              any.missing = FALSE,
                              null.ok = TRUE,
                              add = coll)
  
  checkmate::assert_character(x = forms, 
                              any.missing = FALSE,
                              null.ok = TRUE,
                              add = coll)
  
  checkmate::assert_character(x = records, 
                              any.missing = FALSE,
                              null.ok = TRUE,
                              add = coll)
  
  checkmate::assert_character(x = events, 
                              any.missing = FALSE,
                              null.ok = TRUE,
                              add = coll)
  
  checkmate::assert_list(x = na, 
                         names = "named", 
                         add = coll)
  
  checkmate::assert_list(x = validation, 
                         names = "named", 
                         add = coll)
  
  checkmate::assert_list(x = cast, 
                         names = "named", 
                         add = coll)
  
  checkmate::assert_list(x = assignment, 
                         names = "named", 
                         types = "function",
                         add = coll)
  

}


# .exportRecordsTyped_validateFieldForm -----------------------------
.exportRecordsTyped_validateFieldForm <- function(rcon, 
                                                  fields, 
                                                  drop_fields, 
                                                  forms, 
                                                  coll){
  # Check that fields (and drop_fields) exist in the project
  
  MetaData <- rcon$metadata()
  ProjectFields <- rcon$fieldnames()
  available_fields <- unique(c(ProjectFields$original_field_name, 
                               ProjectFields$export_field_name, 
                               MetaData$field_name[MetaData$field_type %in% c("calc", "file")], 
                               REDCAP_SYSTEM_FIELDS))
  
  checkmate::assert_subset(x = fields, 
                           choices = available_fields, 
                           add = coll)
  
  checkmate::assert_subset(x = drop_fields, 
                           choices = available_fields, 
                           add = coll)
  
  # Check that the forms exist in the project
  
  checkmate::assert_subset(x = forms, 
                           choices = rcon$instruments()$instrument_name, 
                           add = coll)
}


# .exportRecordsTyped_fieldsArray -----------------------------------

.exportRecordsTyped_fieldsArray <- function(rcon, 
                                            fields, 
                                            drop_fields, 
                                            forms, 
                                            use_original = TRUE)
{
  MetaData <- rcon$metadata()
  
  # exportFieldNames excludes fields of type calc, descriptive, and file
  # We need to wedge them in here or we'll never get them out of the API
  ProjectFields <- rcon$fieldnames()
  
  MissingFromFields <- MetaData[MetaData$field_type %in% c("calc", 
                                                           "file"), ]
  if (nrow(MissingFromFields) > 0){
    # FIXME: We need a test on a project that has no calc or file fields.
    MissingFromFields <- 
      data.frame(original_field_name = MissingFromFields$field_name, 
                 choice_value = NA, 
                 export_field_name = MissingFromFields$field_name, 
                 stringsAsFactors = FALSE)
  
    ProjectFields <- rbind(ProjectFields, MissingFromFields)
  }
  ProjectFields$index <- seq_len(nrow(ProjectFields))
  
  # Make a reference table between fields and forms
  FieldFormMap <- MetaData[c("field_name", "form_name")]
  
  FieldFormMap <- 
    merge(ProjectFields, 
          FieldFormMap, 
          by.x = c("original_field_name"), 
          by.y = "field_name", 
          all.x = TRUE)
  
  # Assign [form]_complete fields to their forms
  FieldFormMap$form_name <- 
    ifelse(is.na(FieldFormMap$form_name) &   # if form name is missing and end in _complete
             grepl(pattern = "_complete$", 
                   x = FieldFormMap$original_field_name), 
           yes = sub(pattern = "(^.+)(_complete$)", 
                     replacement = "\\1", # replace with anything before _complete 
                     FieldFormMap$original_field_name), 
           no = FieldFormMap$form_name)
  
  # If fields and forms are both NULL, the default behavior is to grab 
  # all of the fields.
  # Otherwise, we will only include those specified through those arguments
  
  FieldFormMap$is_in_fields <-
    rep((length(fields) == 0 && length(forms) == 0), 
        nrow(FieldFormMap))
  
  # For the forms, we cannot assume they are in forms. Instead, we initialize
  # this to FALSE and have to provide positive proof that they are in forms.
  FieldFormMap$is_in_forms <- rep(FALSE, nrow(FieldFormMap))
  
  # Change is_in_fields to TRUE for those in fields
  if (length(fields) > 0){
    FieldFormMap$is_in_fields <- 
      FieldFormMap$original_field_name %in% fields | 
      FieldFormMap$export_field_name %in% fields
  }
  
  # Change is_in_forms to TRUE for fields that are in one of forms.
  if (length(forms) > 0){
    FieldFormMap$is_in_forms <- 
      FieldFormMap$form_name %in% forms
  }
  
  FieldFormMap <- 
    split(FieldFormMap, 
          FieldFormMap$original_field_name)
  
  # If any of the checkbox options are included in fields, 
  # mark all of the options for inclusion
  FieldFormMap <- lapply(FieldFormMap, 
                         function(FFM){
                           if (any(FFM$is_in_fields)){
                             FFM$is_in_fields <- rep(TRUE, nrow(FFM))
                           }
                           FFM
                         })
  
  # If any of the checkbox options are listed if drop_fields
  # Remove all of the checkbox options.
  # Also sets the is_in_forms to FALSE to ensure it is not 
  # included in the API call.
  
  if (length(drop_fields) > 0){
    FieldFormMap <- 
      lapply(FieldFormMap, 
             function(FFM, drop){
               all_field <- c(FFM$original_field_name, 
                              FFM$export_field_name)
               if (any(all_field %in% drop)){
                 FFM$is_in_fields <- rep(FALSE, nrow(FFM))
                 FFM$is_in_forms <- rep(FALSE, nrow(FFM))
               }
               FFM
             }, 
             drop = drop_fields)
  }
  
  # Combine the list
  FieldFormMap <- do.call("rbind", FieldFormMap)
  rownames(FieldFormMap) <- NULL
  
  # Reduce to fields in either fields or forms
  Fields <- FieldFormMap[FieldFormMap$is_in_fields | 
                           FieldFormMap$is_in_forms, ]
  Fields <- Fields[order(Fields$index), ]
  
  fields_to_request <- 
    if (use_original){
      unique(Fields$original_field_name)
    } else {
      Fields$export_field_name
    }
  
  # Lastly, we need to ensure that the identifier fields are included.
  # We will include the record ID field if it is not already included.
  # We will also include the secondary unique ID field if one is specified.

  id_fields <- getProjectIdFields(rcon)

  fields_to_request <- c(id_fields, fields_to_request)
  fields_to_request <- fields_to_request[!duplicated(fields_to_request)]
  fields_to_request
}

# .exportRecordsTyped_Unbatched -------------------------------------
.exportRecordsTyped_Unbatched <- function( rcon, 
                                           body, 
                                           records, 
                                           config, 
                                           api_param, 
                                           csv_delimiter, 
                                           error_handling)
{
  response <- makeApiCall(rcon, 
                          body = c(body, 
                                   api_param, 
                                   vectorToApiBodyList(records, "records")), 
                          config = config)
  
  if (response$status_code != 200){
    redcapError(response, 
                 error_handling = error_handling)
  } 
  
  if (trimws(as.character(response)) == ""){
    message("No data found in the project.")
    return(data.frame())
  }
  
  utils::read.csv(text = as.character(response), 
                  stringsAsFactors = FALSE, 
                  na.strings = "", 
                  colClasses = "character", 
                  sep = csv_delimiter)
}

# .exportRecordsTyped_Batched ---------------------------------------
.exportRecordsTyped_Batched <- function( rcon, 
                                         body, 
                                         records, 
                                         config, 
                                         api_param, 
                                         csv_delimiter, 
                                         batch_size, 
                                         error_handling)
{
  # If records were not provided, get all the record IDs from the project
  if (length(records) == 0)
  {
    target_field <- rcon$metadata()$field_name[1]
    record_response <- makeApiCall(rcon, 
                                   body = c(list(content = "record", 
                                                 format = "csv", 
                                                 outputFormat = "csv"), 
                                            vectorToApiBodyList(target_field, 
                                                                "fields")))
    
    if (record_response$status_code != 200){
      redcapError(record_response, 
                   error_handling = error_handling)
    }
    
    if (trimws(as.character(record_response)) == ""){
      message("No data found in the project.")
      return(data.frame())
    }
    
    records <- utils::read.csv(text = as.character(record_response), 
                               stringsAsFactors = FALSE, 
                               na.strings = "", 
                               sep = csv_delimiter)
    records <- records[[target_field]]
  }
  
  # group is a vector of integers where each integer is repeated up to 
  # batch_size times. Used to separate records into a list where
  # each element has a maximum length of batch_size
  group <- rep(seq((length(records) %/% batch_size) + 1), 
               each = batch_size, 
               length.out = length(records))
  
  records <- split(records, group)
  
  # Call the API for each batch of records
  Batched <- 
    lapply(records, 
           function(r){ 
             .exportRecordsTyped_Unbatched(rcon = rcon, 
                                           body = body, 
                                           records = r, 
                                           config = config, 
                                           api_param = api_param, 
                                           csv_delimiter = csv_delimiter)})
  
  # Combine the data
  Batched <- do.call("rbind", Batched)
  rownames(Batched) <- NULL
  Batched
}


#' @name exportBulkRecords
#' @title A helper function to export multiple records and forms using
#' a single call.
#' @description Exports records from multiple REDCap Databases using
#' multiple calls to [exportRecordsTyped()]
#'
#' @inheritParams common-rcon-arg
#' @param forms A named list that is a subset of rcon's names. A specified `rcon`
#'              will provide a list of forms for repeated calls to `exportRecordsType`.
#'              If a connection reference is missing it will default to all forms. To override
#'              this default specify a connection's forms with NA to just get all
#'              data. 
#' @param envir A environment to write the resulting Records in as variables
#'   given by their name in rcon or if from a form their rcon named pasted to 
#'   their form name joined by `sep`. If not specified the function
#'   will return a named list with the results. Will accept a number of the
#'   environment.
#' @param sep A character string to use when joining the rcon name to the form name
#' for storing variables. 
#' @param post A function that will run on all returned sets of Records. 
#' @param \dots Any additional variables to pass to [exportRecordsTyped()].
#' @return Will return a named list of the resulting records if `envir` is 
#'    NULL. Otherwise will assign them to the specified `envir`.
#' @examples
#' \dontrun{
#' unlockREDCap(c(test_conn    = 'TestRedcapAPI',
#'                sandbox_conn = 'SandboxAPI'),
#'              keyring      = 'MyKeyring',
#'              envir        = globalenv(),
#'              url          = 'https://<REDCAP_URL>/api/') 
#'
#'# After user interaction to unlock the local encrypted keyring
#'# the global environment will contain the REDCap connections
#'# `test_conn` and `sandbox_conn`
#'# 
#'# Next the user wants to bulk specify importing all the forms
#'# of interest and post process
#'
#'exportBulkRecords(
#'  rcon  = list(test = test_conn,
#'               sand = sandbox_conn),
#'  forms = list(test = c('form1', 'form2'),
#'  envir = globalenv(),
#'  post  = function(Records, rcon)
#'          {
#'            Records              |>
#'            mChoiceCast(rcon)    |>
#'            guessDat(rcon)       |>
#'            widerRepeating(rcon)
#'          }
#'  )
#'  
#'# The environment now contains the data.frames: `test.form1`, `test.form2`, `sand`.
#'# Each of these were retrieved, possibly using the forms argument and all were
#'# post processed in the same manner as specified by `post`.
#' }
#' @export

exportBulkRecords <- function(rcon, forms=NULL, envir=NULL, sep="_", post=NULL, ...)
{
  if(is.numeric(envir)) envir <- as.environment(envir)
  
  coll <- checkmate::makeAssertCollection()
  
  checkmate::assert_list(     x       = rcon,
                              types   = "redcapApiConnection",
                              min.len = 1,
                              names   = "named",
                              add     = coll)
  
  checkmate::assert_list(     x       = forms,   # First, just verify that it is actually a list that was passed. 
                              names   = "named",
                              null.ok = TRUE,
                              add     = coll)
  
  checkmate::assert_class(    x       = envir,
                              classes = "environment",
                              null.ok = TRUE,
                              add     = coll)
  
  checkmate::assert_character(x       = sep,
                              len     = 1,
                              add     = coll)
  
  checkmate::assert_function( x       = post,
                              nargs   = 2,
                              null.ok = TRUE,
                              add     = coll)
  
  checkmate::reportAssertions(coll)
  
  if(!is.null(forms))
  {
    forms[is.na(forms)] <- NA_character_ 
    
    checkmate::assert_subset( x       = names(forms),
                              choices = names(rcon),
                              add     = coll)
    
    checkmate::assert_list( x       = forms,
                            types   = c("character"),
                            add     = coll)
  }
  
  checkmate::reportAssertions(coll)
  
  dest <- list()
  
  if(is.null(forms)) forms <- list()
  
  # For each dataset requested
  for(i in names(rcon))
  {
    conn  <- rcon[[i]]
    f     <- forms[[i]]
    
    lform <- if(is.null(f))                 conn$instruments()$instrument_name else
             if(length(f) == 1 && is.na(f)) NULL                               else
                                            forms[[i]]
    lform <- lform[!is.na(lform)] # Just in case NA's are spread about
    
    if(is.null(lform))
    {
      dest[[i]] <- exportRecordsTyped(conn, ...)
      if(!is.null(post)) dest[[i]] <- post(dest[[i]], conn)
    } else
    {
      for(j in lform)
      {
        name <- paste0(i, sep, j)
        dest[[name]] <- exportRecordsTyped(conn, forms=j, ...)
        if(!is.null(post)) dest[[name]] <- post(dest[[name]], conn)
      }
    }
  }
  
  if(is.null(envir)) dest else list2env(dest, envir=envir)
}

Try the redcapAPI package in your browser

Any scripts or data that you put into this service are public.

redcapAPI documentation built on Sept. 13, 2023, 1:07 a.m.