R/first_case_selection.R

In jomuller/ITCARES: an Interactive Tool for Case-crossover Analyses of electronic medical REcords for patient Safety

#' @title First Case selection
#'
#' @description Selects the first case stays of electronic medical records (EMRs) dataset
#' and exclude patients with stays containing exclusion criteria within two years.
#'
#' @details 
#' A case is defined as a patient who has experienced the primary outcome 
#' for the first time. Patients are excluded if they had a medical history 
#' defined by a list of one or more exclusion criteria. Stays containing one or more
#' exclusion criteria are sought within a two year period before case.
#' Any patient exceeding maximum number of stays is discarded.
#' 
#' @param data A data.table of electronic medical records (EMRs).
#' @param diagnoses_case A character vector containing codes to identify 
#' primary outcome diagnoses in stays.
#' @param diagnoses_exclusion A character vector containing codes to identify
#' exclusion diagnoses in stays.
#' @param exclude_in_case_stay A Boolean. If TRUE, a case stay containing an 
#' exclusion criteria is discarded. If FALSE, case stays are not sought for exclusion
#' criteria.
#' @param n_of_stays_max A scalar giving the maximum number of stays allowed in
#' the whole database for a unique patient.
#'
#' @return A \code{data.table} with selected first case stays. 
#' @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
#' 


first_case <- function(
  data,
  diagnoses_case,
  diagnoses_exclusion,
  exclude_in_case_stay,
  n_of_stays_max
){
  
  # Control
  for (parameter in c("data","diagnoses_case","diagnoses_exclusion",
                      "exclude_in_case_stay","n_of_stays_max")){
    
    if (!exists(x = parameter, inherits = FALSE)){
      stop(paste0(parameter, " missing with no default"))
    }
    
  }
  
  # [Id Stays] Cases
  id_stays_cases <- 
    stays_by_diagnoses(data = data, diagnoses_vector = diagnoses_case)
  
  # [Id Stays] Exclusion
  if(diagnoses_exclusion == ""){
    diagnoses_exclusion <- '@#NA#@$'
  }
  
  id_stays_excluded <- 
    stays_by_diagnoses(data = data, diagnoses_vector = diagnoses_exclusion)
  
  # First cases without previous exposure
  cases <- exclusions(
    data = data,
    id_stays_cases = id_stays_cases,
    id_stays_excluded = id_stays_excluded, 
    exclude_in_case_stay = exclude_in_case_stay,
    n_of_stays_max = n_of_stays_max
  )
  
  return(cases)
}