implement export_survey_fields()

see #159

R/redcap-project.R

@@ -52,6 +52,7 @@ redcap_project <- setRefClass(
       batch_size = 100L, interbatch_delay = 0,
       records = NULL, records_collapsed = "",
       fields = NULL, fields_collapsed = "",
+      export_survey_fields = FALSE,
       export_data_access_groups = FALSE,
       raw_or_label = 'raw',
       verbose = TRUE, config_options = NULL

R/redcap-read-oneshot.R

@@ -13,8 +13,9 @@
 #' @param filter_logic String of logic text (e.g., `[gender] = 'male'`) for filtering the data to be returned by this API method, in which the API will only return the records (or record-events, if a longitudinal project) where the logic evaluates as TRUE.   An blank/empty string returns all records.
 #' @param events An array, where each element corresponds a desired project event  Optional.
 #' @param events_collapsed A single string, where the desired event names are separated by commas.  Optional.
+#' @param export_survey_fields A boolean that specifies whether to export the survey identifier field (e.g., 'redcap_survey_identifier') or survey timestamp fields (e.g., instrument+'_timestamp') .
 #' @param export_data_access_groups A boolean value that specifies whether or not to export the `redcap_data_access_group` field when data access groups are utilized in the project. Default is `FALSE`. See the details below.
-#' @param raw_or_label A string (either `'raw'` or `'label'` that specifies whether to export the raw coded values or the labels for the options of multiple choice fields.  Default is `'raw'`.
+#' @param raw_or_label A string (either `'raw'` or `'label'`) that specifies whether to export the raw coded values or the labels for the options of multiple choice fields.  Default is `'raw'`.
 #' @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 `POST` method in the `httr` package.  See the details below. Optional.
 #' @return Currently, a list is returned with the following elements,
@@ -68,9 +69,11 @@ redcap_read_oneshot <- function(
   redcap_uri, token, records=NULL, records_collapsed="",
   fields=NULL, fields_collapsed="",
   events=NULL, events_collapsed="",
+  export_survey_fields = FALSE,
   export_data_access_groups=FALSE,
   filter_logic="",
-  raw_or_label='raw', verbose=TRUE, config_options=NULL
+  raw_or_label='raw',
+  verbose=TRUE, config_options=NULL
 ) {
   #TODO: NULL verbose parameter pulls from getOption("verbose")
 
@@ -98,18 +101,21 @@ redcap_read_oneshot <- function(
     events_collapsed <- ifelse(is.null(events), "", paste0(events, collapse=",")) #This is an empty string if `events` is NULL.
   if( all(nchar(filter_logic)==0) )
     filter_logic <- ifelse(is.null(filter_logic), "", filter_logic) #This is an empty string if `filter_logic` is NULL.
+  checkmate::assert_logical(export_survey_fields, any.missing=F, len=1)
 
   if( any(grepl("[A-Z]", fields_collapsed)) )
     warning("The fields passed to REDCap appear to have at least uppercase letter.  REDCap variable names are snake case.")
 
   export_data_access_groups_string <- ifelse(export_data_access_groups, "true", "false")
+  export_survey_fields             <- tolower(as.character(export_survey_fields))
 
   post_body <- list(
     token                   = token,
     content                 = 'record',
     format                  = 'csv',
     type                    = 'flat',
     rawOrLabel              = raw_or_label,
+    exportSurveyFields      = export_survey_fields,
     exportDataAccessGroups  = export_data_access_groups_string,
     # records               = ifelse(nchar(records_collapsed)   > 0, records_collapsed  , NULL),
     # fields                = ifelse(nchar(fields_collapsed)    > 0, fields_collapsed   , NULL),

R/redcap-read.R

@@ -19,6 +19,7 @@
 #' @param filter_logic String of logic text (e.g., `[gender] = 'male'`) for filtering the data to be returned by this API method, in which the API will only return the records (or record-events, if a longitudinal project) where the logic evaluates as TRUE.   An blank/empty string returns all records.
 #' @param events An array, where each element corresponds a desired project event  Optional.
 #' @param events_collapsed A single string, where the desired event names are separated by commas.  Optional.
+#' @param export_survey_fields A boolean that specifies whether to export the survey identifier field (e.g., 'redcap_survey_identifier') or survey timestamp fields (e.g., instrument+'_timestamp') .
 #' @param export_data_access_groups A boolean value that specifies whether or not to export the `redcap_data_access_group` field when data access groups are utilized in the project. Default is `FALSE`. See the details below.
 #' @param raw_or_label A string (either 'raw` or 'label' that specifies whether to export the raw coded values or the labels for the options of multiple choice fields.  Default is `'raw'`.
 #' @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.
@@ -69,6 +70,7 @@ redcap_read <- function(
   redcap_uri, token, records=NULL, records_collapsed="",
   fields=NULL, fields_collapsed="",
   events=NULL, events_collapsed="",
+  export_survey_fields = FALSE,
   export_data_access_groups=FALSE,
   filter_logic="",
   raw_or_label='raw',
@@ -171,6 +173,7 @@ redcap_read <- function(
       fields_collapsed            = fields_collapsed,
       filter_logic                = filter_logic,
       events_collapsed            = events_collapsed,
+      export_survey_fields        = export_survey_fields,
       export_data_access_groups   = export_data_access_groups,
       raw_or_label                = raw_or_label,
       verbose                     = verbose,

inst/misc/example.credentials

@@ -10,4 +10,5 @@ redcap_uri,username,project_id,token,comment
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","268","D72C6485B52FE9F75D27B696977FBA43","Russian Characters"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","690","7668169F66720113E844491FFDB65273","Empty rows"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","691","814BA96077C9864D0FFDCABD2778814F","Single column"
+"https://bbmc.ouhsc.edu/redcap/api/","myusername","817","8FA9A6BDAE2C0B5DD3CB472DD8E8918C","static (not longitudinal) survey test project"
 

inst/test-data/project-survey/survey-data-dictionary.csv

@@ -0,0 +1,26 @@
+"Variable / Field Name","Form Name","Section Header","Field Type","Field Label","Choices, Calculations, OR Slider Labels","Field Note","Text Validation Type OR Show Slider Number","Text Validation Min","Text Validation Max",Identifier?,"Branching Logic (Show field only if...)","Required Field?","Custom Alignment","Question Number (surveys only)","Matrix Group Name","Matrix Ranking?","Field Annotation"
+participant_id,prescreening_survey,,text,"Participant ID",,,,,,,,,,,,,
+dob,prescreening_survey,"Please fill out the information below.",text,"Date of birth",,,date_ymd,,,,,,,,,,
+email,prescreening_survey,,text,"E-mail address",,,email,,,y,,,,,,,
+has_diabetes,prescreening_survey,,truefalse,"I currently have Type 2 Diabetes",,,,,,,,,,,,,
+consent,prescreening_survey,,checkbox,"By checking this box, I certify that I am at least 18 years old and that I give my consent freely to participant in this study.","1, I consent",,,,,,,,,,,,
+first_name,participant_info_survey,"As a participant in this study, please answer the questions below. Thank you!",text,"First Name",,,,,,y,,,,,,,
+last_name,participant_info_survey,,text,"Last Name",,,,,,y,,,,,,,
+address,participant_info_survey,,notes,"Street, City, State, ZIP",,,,,,y,,,,,,,
+telephone_1,participant_info_survey,,text,"Phone number",,"Include Area Code",phone,,,y,,,,,,,
+ethnicity,participant_info_survey,,radio,Ethnicity,"0, Hispanic or Latino | 1, NOT Hispanic or Latino | 2, Unknown / Not Reported",,,,,,,,LH,,,,
+race,participant_info_survey,,dropdown,Race,"0, American Indian/Alaska Native | 1, Asian | 2, Native Hawaiian or Other Pacific Islander | 3, Black or African American | 4, White | 5, More Than One Race | 6, Unknown / Not Reported",,,,,,,,,,,,
+sex,participant_info_survey,,radio,Gender,"0, Female | 1, Male",,,,,,,,,,,,
+height,participant_info_survey,,text,"Height (cm)",,,number,130,215,,,,,,,,
+weight,participant_info_survey,,text,"Weight (kilograms)",,,integer,35,200,,,,,,,,
+pmq1,participant_morale_questionnaire,"As a participant in this study, please answer the questions below. Thank you!",dropdown,"On average, how many pills did you take each day last week?","0, Less than 5 | 1, 5-10 | 2, 6-15 | 3, Over 15",,,,,,,,,,,,
+pmq2,participant_morale_questionnaire,,dropdown,"Using the handout, which level of dependence do you feel you are currently at?","0, 0 | 1, 1 | 2, 2 | 3, 3 | 4, 4 | 5, 5",,,,,,,,,,,,
+pmq3,participant_morale_questionnaire,,yesno,"Would you be willing to discuss your experiences with a psychiatrist?",,,,,,,,,,,,,
+pmq4,participant_morale_questionnaire,,dropdown,"How open are you to further testing?","0, Not open | 1, Undecided | 2, Very open",,,,,,,,,,,,
+complete_study,completion_data,"This form is to be filled out by study personnel.",yesno,"Has patient completed study?",,,,,,,,,,,,,
+withdraw_date,completion_data,,text,"Put a date if patient withdrew study",,,date_ymd,,,,,,,,,,
+withdraw_reason,completion_data,,dropdown,"Reason patient withdrew from study","0, Non-compliance | 1, Did not wish to continue in study | 2, Could not tolerate the supplement | 3, Hospitalization | 4, Other",,,,,,,,,,,,
+date_visit_4,completion_data,,text,"Date of last visit",,,date_ymd,,,,,,,,,,
+discharge_date_4,completion_data,,text,"Date of hospital discharge",,,date_ymd,,,,,,,,,,
+discharge_summary_4,completion_data,,dropdown,"Discharge summary in patients binder?","0, No | 1, Yes",,,,,,,,,,,,
+study_comments,completion_data,,notes,Comments,,,,,,,,,,,,,

inst/test-data/project-survey/survey-data.csv

@@ -0,0 +1,3 @@
+participant_id,redcap_survey_identifier,prescreening_survey_timestamp,dob,email,has_diabetes,consent___1,prescreening_survey_complete,participant_info_survey_timestamp,first_name,last_name,address,telephone_1,ethnicity,race,sex,height,weight,participant_info_survey_complete,participant_morale_questionnaire_timestamp,pmq1,pmq2,pmq3,pmq4,participant_morale_questionnaire_complete,complete_study,withdraw_date,withdraw_reason,date_visit_4,discharge_date_4,discharge_summary_4,study_comments,completion_data_complete
+1,,"2018-03-06 15:52:43",2018-03-06,[email protected],1,1,2,,,,,,,,,,,0,,,,,,0,,,,,,,,0
+2,,"2018-03-06 15:53:15",2018-03-05,[email protected],0,0,2,,,,,,,,,,,0,,,,,,0,,,,,,,,0

tests/testthat/test-read-batch-survey.R

@@ -0,0 +1,84 @@
+library(testthat)
+context("Read Batch - Survey")
+
+credential <- REDCapR::retrieve_credential_local(
+  path_credential = base::file.path(pkgload::inst(name="REDCapR"), "misc/example.credentials"),
+  project_id      = 817
+)
+project <- redcap_project$new(redcap_uri=credential$redcap_uri, token=credential$token)
+directory_relative <- "test-data/project-survey/expected"
+
+test_that("Smoke Test", {
+  testthat::skip_on_cran()
+
+  #Static method w/ default batch size
+  expect_message(
+    returned_object <- redcap_read(
+      redcap_uri=credential$redcap_uri, token=credential$token, export_survey_fields=T
+    )
+  )
+  #Instance method w/ default batch size
+  expect_message(
+    returned_object <- project$read(export_survey_fields=T)
+  )
+
+  #Instance method w/ tiny batch size
+  expect_message(
+    returned_object <- project$read(batch_size=2, export_survey_fields=T)
+  )
+})
+
+test_that("SO example for data.frame retreival", {
+  file_name <- "dummy.rds"
+  path_qualified <- base::file.path(pkgload::inst(name="REDCapR"), directory_relative, file_name)
+
+  actual <- data.frame(a=1:5, b=6:10) # saveRDS(actual, file.path("./inst", directory_relative, file_name))
+  expect_true(file.exists(path_qualified), "The saved data.frame should be retrieved from disk.")
+  expected <- readRDS(path_qualified)
+  expect_equal(actual, expected, label="The returned data.frame should be correct")
+})
+
+test_that("All Records -Default", {
+  testthat::skip_on_cran()
+
+  file_name <- "default.rds"
+  path_qualified <- base::file.path(pkgload::inst(name="REDCapR"), directory_relative, file_name)
+
+  expected_outcome_message <- "\\d+ records and \\d+ columns were read from REDCap in \\d+(\\.\\d+\\W|\\W)seconds\\."
+
+  # saveRDS(returned_object1$data, file.path("./inst", directory_relative, file_name), compress="xz")
+  # saveRDS(returned_object2$data, file.path("./inst", directory_relative, file_name), compress="xz")
+  expected_data_frame <- readRDS(path_qualified)
+  # expected_data_frame <- eval(parse(path_expected), enclos = new.env()) #dput(returned_object1$data, file=path_expected)
+
+  ###########################
+  ## Default Batch size
+  expect_message(
+    regexp            = expected_outcome_message,
+    returned_object1 <- redcap_read(redcap_uri=credential$redcap_uri, token=credential$token, export_survey_fields=T)
+  )
+  expect_equal(returned_object1$data, expected=expected_data_frame, label="The returned data.frame should be correct") # dput(returned_object1$data)
+  expect_true(all(!is.na(returned_object1$data$prescreening_survey_timestamp)))
+  expect_true(returned_object1$success)
+  expect_match(returned_object1$status_codes, regexp="200", perl=TRUE)
+  expect_true(returned_object1$records_collapsed=="", "A subset of records was not requested.")
+  expect_true(returned_object1$fields_collapsed=="", "A subset of fields was not requested.")
+  expect_true(nchar(returned_object1$filter_logic)==0L, "A filter was not specified.")
+  expect_match(returned_object1$outcome_messages, regexp=expected_outcome_message, perl=TRUE)
+
+  ###########################
+  ## Tiny Batch size
+  expect_message(
+    regexp            = expected_outcome_message,
+    returned_object2 <- redcap_read(redcap_uri=credential$redcap_uri, token=credential$token, export_survey_fields=T, batch_size=8)
+  )
+
+  expect_equal(returned_object2$data, expected=expected_data_frame, label="The returned data.frame should be correct") # dput(returned_object2$data)
+  expect_true(all(!is.na(returned_object1$data$prescreening_survey_timestamp)))
+  expect_true(returned_object2$success)
+  expect_match(returned_object2$status_codes, regexp="200", perl=TRUE)
+  expect_true(returned_object2$records_collapsed=="", "A subset of records was not requested.")
+  expect_true(returned_object2$fields_collapsed=="", "A subset of fields was not requested.")
+  expect_true(nchar(returned_object2$filter_logic)==0L, "A filter was not specified.")
+  expect_match(returned_object2$outcome_messages, regexp=expected_outcome_message, perl=TRUE)
+})