R/age_check.r

In mmparker/to1check: Reporting and quality checks for TBESC TO 1 data

#' Checks that pre-enrollment ages match calculated ages.
#' 
#' This function checks that the ages given on pre-enrollments match those
#' calculated from reported dates of birth (Section A) and the particpant's
#' visit date (Section A).
#' 
#' Ages are given in years; calculated ages are rounded down. 
#' 
#' @return
#' \code{age_check} returns a data.frame 
#' of participants with incongruent ages with study ID, birth date, visit date,
#' pre-enrollment age, calculated age, and the difference between the two ages
#' in years. 
#' The data.frame is ordered by decreasing size of the discrepancy.
#' 
#' 
#' @param cleanlist The list of cleaned TO1 data generated by 
#'   \code{\link{clean_to1}}
#' 
#' @export



age_check <- function(cleanlist) {


    # Get the ages
    ages <- merge(x = cleanlist$preenrollment[ , c("StudyID", "VisitDate", 
                                                   "AgeAtEnrollment")],
                  y = cleanlist$master[ , c("StudyID", "BirthDate")],
                  by = "StudyID")



    # Rename AgeAtEnrollment to be clear about its source
    names(ages)[names(ages) %in% "AgeAtEnrollment"] <- "preenroll_age"


    ########################################################################### 
    # Compare pre-enrollment and Enrollment Date - DOB ages
    ########################################################################### 

    # Calculate age at enrollment
    ages$calc_age <- 
        as.period(new_interval(ages$BirthDate, ages$VisitDate),
                  unit = "year")$year

    ages$age_diff <- abs(ages$calc_age - ages$preenroll_age)


    # Identify participants with different pre-enroll and questionnaire ages
    ages_out <- ages[which(ages$age_diff > 0),
                     c("StudyID", "BirthDate", "VisitDate",
                      "preenroll_age", "calc_age", "age_diff")]


    # Sort by age difference and output
    ages_out[order(ages_out$age_diff, ages_out$VisitDate, decreasing = TRUE), ]



}