R/baseline_characterisation.R

In seamuskent/ehdenHtaCopd: The package generates evidence for HTA in COPD

##################################
#### BASELINE CHARACTERISATION ###
##################################

#' @export
# Create as function
gen_baseline_characterisation <- function(){

### INITIAL PREPARATION ----

# select pre-defined baseline features of interest
covariateSettings <- createCovariateSettings(useDemographicsGender = TRUE,
                                             useDemographicsAgeGroup = TRUE,
                                             useDemographicsAge = TRUE,
                                             useVisitConceptCountLongTerm = TRUE,
                                             endDays = -1)

# create covariate settings for previous MI
miCovSet <- createMiHistCovariateSettings(useHistoryOfMI = TRUE, covariateID = 1, analysisID = 1001)

# combine pre-defined and custom covariates
covariateSettingsList <- list(covariateSettings, miCovSet)

# Tab1 - create empty table for new variables and add rows / variables
addTabVars <- getDefaultTable1Specifications()[FALSE,]
addTabVars[nrow(addTabVars)+1, 1] <- "MI"; addTabVars[nrow(addTabVars), 2:3] <- c(1001, 1)

# Tab1 - combine with existing settings table
skTableOneSettings <- dplyr::bind_rows(getDefaultTable1Specifications(), addTabVars)

### COHORT 1 - COPD DIAG AND DRUG EVIDENCE ----

# Extract data and aggregate
covariates_pp <- getDbCovariateData(connectionDetails = connectionDetails,
                                 cdmDatabaseSchema = cdmDbSchema,
                                 cohortDatabaseSchema = cohortDbSchema,
                                 cohortTable = cohortTable,
                                 cohortId = 1,
                                 covariateSettings = covariateSettingsList)
covariates_agg <- aggregateCovariates(covariates_pp)

# generate detailed summaries of categorical covariates
bl_char_cohort1_catVars <- dplyr::left_join(covariates_agg$covariates[,], covariates_agg$covariateRef[,], by = "covariateId")

# continuous data
bl_char_cohort1_contVars <- dplyr::left_join(as.data.frame(covariates_agg$covariatesContinuous[,]), covariates_agg$covariateRef[,], by = "covariateId")

# create table one
if (exists("bl_char_cohort1_tab1")) rm(bl_char_cohort1_tab1)
bl_char_cohort1_tab1 <- createTable1(covariateData1 = covariates_agg, specifications = skTableOneSettings, output = "list")

### COHORT 2 - COPD DIAG ONLY ----
# Extract data and aggregate
covariates_pp <- getDbCovariateData(connectionDetails = connectionDetails,
                                    cdmDatabaseSchema = cdmDbSchema,
                                    cohortDatabaseSchema = cohortDbSchema,
                                    cohortTable = cohortTable,
                                    cohortId = 2,
                                    covariateSettings = covariateSettingsList)
covariates_agg <- aggregateCovariates(covariates_pp)

# generate detailed summaries of categorical covariates
bl_char_cohort2_catVars <- dplyr::left_join(covariates_agg$covariates[,], covariates_agg$covariateRef[,], by = "covariateId")

# continuous data
bl_char_cohort2_contVars <- dplyr::left_join(as.data.frame(covariates_agg$covariatesContinuous[,]), covariates_agg$covariateRef[,], by = "covariateId")

# create table one
if (exists("bl_char_cohort2_tab1")) rm(bl_char_cohort2_tab1)
bl_char_cohort2_tab1 <- createTable1(covariateData1 = covariates_agg, specifications = skTableOneSettings, output = "list")

# RESULTS TO EXTRACT ----

# set up results list
res.list <- list("cat_vars" = NULL, "cont_vars" = NULL, "table1" = NULL)

# initiate outcomes list
out.list <- list("cohort1_COPD_diag_and_drug_exposure" = res.list, "cohort2_COPD_diag" = res.list)

# add in results
out.list$cohort1_COPD_diag_and_drug_exposure$cat_vars <- bl_char_cohort1_catVars
out.list$cohort1_COPD_diag_and_drug_exposure$cont_vars <- bl_char_cohort1_contVars
out.list$cohort1_COPD_diag_and_drug_exposure$table1 <- bl_char_cohort1_tab1
out.list$cohort2_COPD_diag$cat_vars <- bl_char_cohort2_catVars
out.list$cohort2_COPD_diag$cont_vars <- bl_char_cohort2_contVars
out.list$cohort2_COPD_diag$table1 <- bl_char_cohort2_tab1

# output to return
return(out.list)

}