R/age_study_period_restrictions.R

Defines functions age_study_period_restrictions

Documented in age_study_period_restrictions

#' Age and Study period restrictions
#'
#' @description Applies age and study period restrictions
#'
#' @param data A data.table of electronic medical records (EMRs): the same used in first_case().
#' @param cases The 3 columns data.table generated with first_case() function.
#' @param starting_year A scalar giving the first year of the study period.
#' @param final_year A scalar giving the last year of the study period.
#' @param age_min A scalar giving the last year of the study period.
#' @param final_year A scalar giving the minimum age for patient inclusion.
#' @param age_max A scalar giving the maximum age for patient inclusion.
#'
#' @return A data.table
#' @export 
#'
#' @examples 
#' data(ep)
#' obj0 <- ep
#' 
#' obj1 <- first_case(
#'   data = obj0,
#'   diagnoses_case =  'PE',
#'   diagnoses_exclusion = 'EXCLUSION',
#'   exclude_in_case_stay = FALSE,
#'   n_of_stays_max = 20
#' )
#' 
#' obj1 
#' 
#' obj2 <- age_study_period_restrictions(
#'   data = obj0,
#'   cases = obj1,
#'   starting_year = 2007,
#'   final_year = 2013,
#'   age_min = 0,
#'   age_max = 120
#' )
#' 
#' obj2
#' 
#' obj3 <- case_crossover(
#'   case_stay = obj2,
#'   data = obj0,
#'   exposure_diagnoses = '',
#'   exposure_procedures = 'THR',
#'   screening_index_stay = FALSE,
#'   unique_exposure = TRUE,
#'   interval_length = 42,
#'   number_of_interval = 8,
#'   wash_out = 365,
#'   los_max = 42
#' )
#' obj3 
#' obj3$graph
#' @export
#' 
#' @details 
#' A patient is included if its age is within the defined range and if one or more 
#' diagnoses is identified within the study period (excluding the first two years).

age_study_period_restrictions <- function(
  
  data,
  cases,
  starting_year,
  final_year,
  age_min = NULL,
  age_max = NULL
  
){
  
  # Control
  for (parameter in c("data","cases","starting_year","final_year")){
    
    if (!exists(x = parameter, inherits = FALSE)){stop(paste(parameter, "missing with no default"))}
    
  }
  
  # [Id Stays] Age
  id_age_selection <- 
    age_exclusion(data = data, age_min = age_min, age_max = age_max)
  
  # [Id Stays] Years
  id_stays_years <- 
    stays_by_years(data = data, years_vector = starting_year+2:final_year)
  
  cases_final <- cases %>%
    semi_join(id_stays_years) %>%
    anti_join(id_age_selection) %>%
    ungroup() %>% select(id_patient, id_stay) %>%
    left_join(select(data, id_patient, id_stay,case_date = admission))
  
  return(cases_final)
  
}
jomuller/ITCARES documentation built on May 19, 2019, 7:26 p.m.