---
title: "Building base cohorts"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{a01_building_base_cohorts}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
eval = TRUE, 
warning = FALSE, 
message = FALSE,
comment = "#>"
)
```

## Introduction

Let's first create a cdm reference to the Eunomia synthetic data.

```{r}
library(omock)
library(CodelistGenerator)
library(PatientProfiles)
library(CohortConstructor)
library(dplyr)
library(CDMConnector)
library(duckdb)

cdm <- mockCdmFromDataset(datasetName = "GiBleed", source = "duckdb")
```

## Concept based cohort creation

A way of defining base cohorts is to identify clinical records with codes from some pre-specified concept list. Here for example we'll first find codes for diclofenac and acetaminophen. We use the `getDrugIngredientCodes()` function from the package **CodelistGenerator** to obtain the codes for these drugs.

```{r}
drug_codes <- getDrugIngredientCodes(cdm, 
                                     name = c("acetaminophen",
                                              "amoxicillin", 
                                              "diclofenac", 
                                              "simvastatin",
                                              "warfarin"))

drug_codes
```

Now we have our codes of interest, we'll make cohorts for each of these where cohort exit is defined as the event start date (which for these will be their drug exposure end date).

```{r}
cdm$drugs <- conceptCohort(cdm, 
                           conceptSet = drug_codes,
                           exit = "event_end_date",
                           name = "drugs")

settings(cdm$drugs)
cohortCount(cdm$drugs)
attrition(cdm$drugs)
```

This creates a cohort where individuals are defined by their exposure to the specified drugs, and their cohort duration is determined by the exposure end date.

Next, let's create a cohort for individuals with bronchitis. We define a set of codes representing bronchitis and use the `conceptCohort()` function to create the cohort. Here, the cohort exit is defined by the event start date (i.e., `event_start_date`). We set `table = "condition_occurrence"` so that the records for the provided concepts will be searched only in the *condition_occurrence* table. We then set `subsetCohort = "drugs"` to restrict the cohort creation to individuals already in the `drugs` cohort. Additionally, we use `subsetCohortId = 1` to include only subjects from the cohort 1 (which corresponds to individuals who have been exposed to warfarin).

```{r}

bronchitis_codes <- list(bronchitis = c(260139, 256451, 4232302))

cdm$bronchitis <- conceptCohort(cdm, 
                           conceptSet = bronchitis_codes,
                           exit = "event_start_date",
                           name = "bronchitis",
                           table = "condition_occurrence", 
                           subsetCohort = "drugs", 
                           subsetCohortId = 1
                           )


cohortCount(cdm$bronchitis)
attrition(cdm$bronchitis)

```

When some records in the cohort overlap, the cohort start date will be set to the earliest start date. If we set `overlap = "merge"`, the cohort end date will be set to the latest end date of the overlapping records. 

```{r}
cdm$drugs_merge <- conceptCohort(cdm, 
                           conceptSet = drug_codes,
                           overlap = "merge",
                           name = "drugs_merge")

cdm$drugs_merge |>
  attrition()

```

Alternatively, if we set `overlap = "extend"`, the cohort end date will be extended by summing the durations of each overlapping record, as depicted in the image below.

![](images/overlap.png)

```{r}
cdm$drugs_extend <- conceptCohort(cdm, 
                           conceptSet = drug_codes,
                           overlap = "extend",
                           name = "drugs_extend")

cdm$drugs_extend |>
  attrition()
```

To create a cohort from a concept set and include records outside the observation period, we can set `useRecordsBeforeObservation = TRUE`. This option shifts records that start before the observation period to the start of the corresponding observation period, and trims records that start or end after the observation period so they fall within that observation period. This behavior is shown in the image below.

![](images/useRecordsBeforeObservation.png)


If we also want to search for the given concepts in the source concept_id fields, rather than only the standard concept_id fields, we can set `useSourceFields = TRUE`.

```{r}

cdm$celecoxib <- conceptCohort(cdm, 
                           conceptSet = list(celecoxib = 44923712),
                           name = "celecoxib", 
                           useRecordsBeforeObservation = TRUE, 
                           useSourceFields = TRUE)
cdm$celecoxib |>
  glimpse()
```

## Demographic based cohort creation

One base cohort we can create is based around patient demographics. Here for example we create a cohort where people enter on their 18th birthday and leave at on the day before their 66th birthday.

```{r}
cdm$working_age_cohort <- demographicsCohort(cdm = cdm, 
                                             ageRange = c(18, 65), 
                                             name = "working_age_cohort")

settings(cdm$working_age_cohort)
cohortCount(cdm$working_age_cohort)
attrition(cdm$working_age_cohort)
```

We can also add an additional requirement of only people of working age with sex "female".

```{r}
cdm$female_working_age_cohort <- demographicsCohort(cdm = cdm, 
                                             ageRange = c(18, 65),
                                             sex = "Female",
                                             name = "female_working_age_cohort")

settings(cdm$female_working_age_cohort)
cohortCount(cdm$female_working_age_cohort)
attrition(cdm$female_working_age_cohort)
```

We can also use this function to create cohorts for different combinations of age groups and sex.

```{r}
cdm$age_sex_cohorts <- demographicsCohort(cdm = cdm, 
                                             ageRange = list(c(0, 17), c(18, 65), c(66,120)),
                                             sex = c("Female", "Male"),
                                             name = "age_sex_cohorts")

settings(cdm$age_sex_cohorts)
cohortCount(cdm$age_sex_cohorts)
attrition(cdm$age_sex_cohorts)

```

We can also specify the minimum number of days of prior observation required.


```{r}
cdm$working_age_cohort_0_365 <- demographicsCohort(cdm = cdm, 
                                             ageRange = c(18, 65), 
                                             name = "working_age_cohort_0_365",
                                             minPriorObservation = c(0,365))

settings(cdm$working_age_cohort_0_365)
cohortCount(cdm$working_age_cohort_0_365)
attrition(cdm$working_age_cohort_0_365)

```

## Measurement Cohort

```{r, include = FALSE}
cdm <- mockVocabularyTables(concept = tibble(
  concept_id = c(4326744, 4298393, 45770407, 8876, 4124457, 1990036),
  concept_name = c("Blood pressure", "Systemic blood pressure",
                   "Baseline blood pressure", "millimeter mercury column",
                   "Normal range", "Overweight"),
  domain_id = "Measurement",
  vocabulary_id = c("SNOMED", "SNOMED", "SNOMED", "UCUM", "SNOMED", "SNOMED"),
  standard_concept = "S",
  concept_class_id = c("Observable Entity", "Observable Entity",
                       "Observable Entity", "Unit", "Qualifier Value", "Qualifier Value"),
  concept_code = NA_character_,
  valid_start_date = as.Date(NA_character_),
  valid_end_date = as.Date(NA_character_),
  invalid_reason = NA_character_
)) |>
  mockCdmFromTables(tables = list(
    measurement = tibble(
      measurement_id = 1:5L,
      person_id = c(1L, 1L, 2L, 3L, 2L),
      measurement_concept_id = c(4326744L, 4298393L, 4298393L, 4245997L, 4245997L),
      measurement_date = as.Date(c("2000-07-01", "2000-12-11", "2002-09-08", "2015-02-19", "2002-09-08")),
      measurement_type_concept_id = 0L,
      value_as_number = c(100, 125, NA, NA, NA),
      value_as_concept_id = c(0L, 0L, 0L, 4124457L, 4328749L),
      unit_concept_id = c(8876L, 8876L, 0L, 0L, 0L)
   )
 ))

# copy the datatbase to duckdb
src <- dbSource(con = dbConnect(drv = duckdb()), writeSchema = "main")
cdm <- insertCdmTo(cdm = cdm, to = src)
```

Another base cohort we can create is based around patient measurements. Here for example we create a cohort of patients who have a normal BMI (BMI between 18 and 25), and a high BMI (BMI between 26 and 40). To do this you must first identify the measurement you want to look at (in this case BMI (concept id = 4245997)), the unit of measurement (kg per square-meter (concept id = 9531)), the 'normal' value concept (concept id = 4069590), and the concept for 'overweight' (concept id = 1990036). The value concept is included for the cases where the exact BMI measurement is not specified, but the BMI category (i.e. normal, overweight, obese etc) is. This means that if a record matches the value concept OR has a normal BMI score then it is included in the cohort.

```{r}
cdm$cohort <- measurementCohort(
  cdm = cdm,
  name = "cohort",
  conceptSet = list("bmi" = c(4245997)),
  valueAsConcept = list("bmi_normal" = c(4069590), "bmi_overweight" = c(1990036)),
  valueAsNumber = list("bmi_normal" = list("9531" = c(18, 25)), "bmi_overweight" = list("9531" = c(26, 30)))
)

attrition(cdm$cohort)
settings(cdm$cohort)
cdm$cohort
```

As you can see in the above code, the concept set is the list of BMI concepts, for the "bmi_normal" cohort, the concept value is the 'normal' weight concept, and the values are the minimum and maximum BMI scores to be considered. Similary for the "bmi_overweight", the concept value refers to "overweight" and the numeric range goes from minimum and maximum BMI score for that category.

It is also possible to include records outside of observation by setting the `useRecordsBeforeObservation` argument to TRUE.

```{r}
cdm$cohort <- measurementCohort(
  cdm = cdm,
  name = "cohort",
  conceptSet = list("bmi" = c(4245997)),
  valueAsConcept = list("bmi_normal" = c(4069590)),
  valueAsNumber = list("bmi_normal" = list("9531" = c(18, 25))),
  useRecordsBeforeObservation = TRUE
)

attrition(cdm$cohort)
settings(cdm$cohort)
cdm$cohort
```

## Death cohort

```{r, include=FALSE}
cdm <- mockCdmFromDataset(datasetName = "GiBleed", source = "duckdb")

cdm$drugs <- conceptCohort(cdm, 
                           conceptSet = drug_codes,
                           exit = "event_end_date",
                           name = "drugs")
```

Another base cohort we can make is one with individuals who have died. For this we'll simply be finding those people in the OMOP CDM death table and creating a cohort with them.

```{r}
cdm$death_cohort <- deathCohort(cdm = cdm,
                                name = "death_cohort")
```

To create a cohort of individuals who have died, but restrict it to those already part of another cohort (e.g., the "drugs" cohort), you can use `subsetCohort = "drugs"`. This ensures that only individuals from the "drugs" cohort are included in the death cohort.

```{r}
cdm$death_drugs <- deathCohort(cdm = cdm,
                               name = "death_drugs",
                               subsetCohort = "drugs")
```
