data-raw/internal_data.R

In JayAchar/hisreportr: hisreportr: Automating MSF OCA EMR reporting

# Generate internal package data frame of PostgreSQL commands
library(tidyverse)

# Define new functions ----
# function to generate final dataframe
new_command <- function(name, command) {
  data.frame(name = name,
             command = command,
             stringsAsFactors = FALSE)
}


# TB SQL queries ----

# define PostgreSQL commands and names for TB report
tb_queries <- list(
  # * TB start treatment ----
  list("tb_start",
       'SELECT patient_id, tb_treatment_start_date AS starttre,
               date_initiation_consulations AS consult_date,
               type_of_tb_regimen AS regimen
        FROM public."2_treatment_initiation_début_de_traitement"
        WHERE start_tb_treatment = \'Yes\';'),
  # * TB baseline registration data ----
  list("tb_registration",
       'SELECT patient_id, obs_datetime AS obs_dt,
               encounter_id,
               date_tb_history_review AS hx_review_date, 
               who_registration_group AS tb_reg_grp, 
               previously_treated_group AS tb_prev_tx_grp, 
               mtb_confirmation, drug_resistance_profile AS dst_profile,
	             sub_class_of_drug_resistance_profile AS dst_sub_profile, 
	             mdr_tb_diagnosis_date AS dr_tb_diag_date
       FROM public."1_history_tb_antécédents_tb";'),
  # * TB anatomical site ----
  list("tb_disease_site",
       'SELECT patient_id, obs_datetime AS obs_dt, encounter_id,
               disease_site_s AS tb_disease_site
        FROM public.disease_site_s;'),

  # * TB age and gender ----
  ## age in years calculated on adm_date

  list("tb_characteristics",
       'SELECT tx.patient_id AS patient_id, 
          adm."Admission_date_Date_d_admission" AS adm_date, 
          gender, age
        FROM public.person_details_default AS pd
          INNER JOIN (
			      SELECT DISTINCT patient_id
 			      FROM public."2_treatment_initiation_début_de_traitement"
 			      WHERE start_tb_treatment = \'Yes\') AS tx
	        ON pd.person_id = tx.patient_id
		    LEFT JOIN public.person_attributes AS adm
	      ON pd.person_id = adm.person_id;'),
  
  # * TB weight and height ----
  list("tb_weight_height", 
       'SELECT wa.patient_id, assessment_date, weight, height
        FROM public."4_weight_assessment_évaluation_du_poids" AS wa
        INNER JOIN (
			      SELECT DISTINCT patient_id
 			      FROM public."2_treatment_initiation_début_de_traitement"
 			      WHERE start_tb_treatment = \'Yes\') AS tx
				      ON wa.patient_id = tx.patient_id'),
  

  # * TB end and outcome ----
  list("tb_end",
       'SELECT patient_id, end_of_treatment_date AS end_date, 
          type_of_tb_treatment_finished AS out_regimen, outcome
        FROM public."6_treatment_outcome_tb_issue_du_traitement_tb"
        WHERE end_of_treatment_date IS NOT NULL 
          OR outcome IS NOT NULL;'))

# data frame of names and PostgreSQL commands
tb_commands <- purrr::map(tb_queries, .f = ~new_command(.x[[1]], .x[[2]])) %>% 
  dplyr::bind_rows()


# HIV SQL queiries ----
# define PostgreSQL commands and names for HIV report
hiv_queries <- list(
  # * HIV start treatment ----
  ## Filter patients & dates where treatment started/switched
  ## Retain the earliest date only
  list("hiv_start",
       'SELECT f.patient_id,
       f.hiv_treatment_start_date AS starttre,
       f.date_initiation_consulations AS consult_date,
       f.type_of_hiv_regimen AS regimen_type
       FROM public."2_treatment_initiation_début_de_traitement" AS f
       INNER JOIN(
         SELECT patient_id, MIN(hiv_treatment_start_date) AS starttre
         FROM public."2_treatment_initiation_début_de_traitement"
         WHERE start_or_switch_hiv_treatment = \'Yes\'
         GROUP BY patient_id) AS st 
       ON f.patient_id = st.patient_id
       AND f.hiv_treatment_start_date = st.starttre'), 
  
  # * HIV age and gender ----
  ## age in years calculated on adm_date
  list("hiv_characteristics",
       'SELECT tx.patient_id AS patient_id, 
          adm."Admission_date_Date_d_admission" AS adm_date, 
          gender, age
        FROM public.person_details_default AS pd
          INNER JOIN (
			      SELECT DISTINCT patient_id
 			      FROM public."2_treatment_initiation_début_de_traitement"
 			      WHERE start_or_switch_hiv_treatment = \'Yes\') AS tx
	        ON pd.person_id = tx.patient_id
		    LEFT JOIN public.person_attributes AS adm
	      ON pd.person_id = adm.person_id'),
  
  # * HIV treatment status changes ----
  list("hiv_status_changes",
       # data from HIV treatment iniation form and HIV treatment status change form
       # bind rows yields columns labelled 'type_of_hiv_regimen'
       # for rows where treatment started or switched (i.e. from form 2) - options include 
        # HIV regimen type - 1st line, 2nd line, 3rd line - or 'Not defined'
        # for 'status change' rows - status change described
       'SELECT ti.patient_id, ti.hiv_treatment_start_date AS hiv_tx_status_date, 
               ti.type_of_hiv_regimen AS hiv_tx_status
        FROM public."2_treatment_initiation_début_de_traitement" AS ti
	    	WHERE ti.start_or_switch_hiv_treatment = \'Yes\'
        UNION
        SELECT sc.patient_id, date_of_status_change, 
               type_of_programmatic_status_change AS status_change
        FROM public."6_status_change_hiv_changement_du_statut_vih" AS sc
        WHERE type_of_programmatic_status_change IS NOT NULL
        ORDER BY patient_id, hiv_tx_status_date;'), 
  
  # * HIV WHO stage ----
  list("hiv_who_stage",
       'SELECT patient_id, visit_date, who_stage 
       FROM public."4_clin_assess_treat_hiv_éval_clin_trait_vih"'), 
  
  # * HIV weight and height ----
  list("hiv_weigth_height", 
       'SELECT wa.patient_id, assessment_date, weight, height
        FROM public."4_weight_assessment_évaluation_du_poids" AS wa
        INNER JOIN (
			      SELECT DISTINCT patient_id
 			      FROM public."2_treatment_initiation_début_de_traitement"
 			      WHERE start_or_switch_hiv_treatment = \'Yes\') AS tx
				      ON wa.patient_id = tx.patient_id'),
  
  # * HIV CD4 and VL ----
  list("hiv_vl_cd4",
       'SELECT tx.patient_id AS patient_id, 
          date_sample_examination AS sample_date,
       lymphocytes_cd4_count AS cd4, hiv_viral_load_detectable AS hiv_vl_detect,
	   hiv_viral_load_result AS hiv_vl
        FROM public."3_lab_virology_lab_virologie" AS vl
          INNER JOIN (
			      SELECT DISTINCT patient_id
 			      FROM public."2_treatment_initiation_début_de_traitement"
 			      WHERE start_or_switch_hiv_treatment = \'Yes\') AS tx
	        ON vl.patient_id = tx.patient_id;'), 
  # * HIV drug treatment ----
  list("hiv_drug_tx",
       'SELECT ep.patient_id, visit_date, 
               decision_on_hiv_arv_treatment AS tx_decision,
               arv_treatment_prescribed AS tx_prescribed
        FROM public."4_clin_assess_treat_hiv_éval_clin_trait_vih" AS ep
	      LEFT JOIN public."4_clin_assess_treat_hiv_éval_clin_trait_vih_arvs_prescribed" AS arv
        ON ep.patient_id = arv.patient_id
		      AND ep.obs_datetime = arv.obs_datetime
 		    WHERE decision_on_hiv_arv_treatment IN (\'Initiation/ Re-initiation\', \'Modification of regimen\')
	        ORDER BY ep.patient_id, visit_date;')
)

# data frame of names and PostgreSQL commands
hiv_commands <- purrr::map(hiv_queries, .f = ~new_command(.x[[1]], .x[[2]])) %>% 
  dplyr::bind_rows()

# HCV SQL queries ----

# define PostgreSQL commands and names for HCV report
hcv_queries <- list(
  # * HCV start treatment ----
  list("hcv_start",
       'SELECT patient_id, hepc_treatment_start_date AS starttre,
               date_initiation_consulations AS consult_date
        FROM public."2_treatment_initiation_début_de_traitement"
        WHERE start_hepc_treatment = \'Yes\';'), 
  
  
  # * HCV age and gender ----
  ## age in years calculated on adm_date
  
  list("hcv_characteristics",
       'SELECT tx.patient_id AS patient_id, 
          adm."Admission_date_Date_d_admission" AS adm_date, 
          gender, age
        FROM public.person_details_default AS pd
          INNER JOIN (
			      SELECT DISTINCT patient_id
 			      FROM public."2_treatment_initiation_début_de_traitement"
 			      WHERE start_hepc_treatment = \'Yes\') AS tx
	        ON pd.person_id = tx.patient_id
		    LEFT JOIN public.person_attributes AS adm
	      ON pd.person_id = adm.person_id'),
  
  # * HCV weight and height ----
  list("hcv_weight_height", 
       'SELECT wa.patient_id, assessment_date, weight, height
        FROM public."4_weight_assessment_évaluation_du_poids" AS wa
        INNER JOIN (
			      SELECT DISTINCT patient_id
 			      FROM public."2_treatment_initiation_début_de_traitement"
 			      WHERE start_hepc_treatment = \'Yes\') AS tx
				      ON wa.patient_id = tx.patient_id'),
  
  # * HCV ECOG score ----
  list("hcv_perf_status",
       'SELECT tx.patient_id AS patient_id, 
          ps.assessment_date,
		  ps.performance_status_ecog
        FROM public."4_performance_status_statut_de_performance" AS ps
          INNER JOIN (
			      SELECT DISTINCT patient_id
 			      FROM public."2_treatment_initiation_début_de_traitement"
 			      WHERE start_hepc_treatment = \'Yes\') AS tx
	        ON ps.patient_id = tx.patient_id;'),
  
  # * HCV genotype data ----
  list("hcv_genotype",
       'SELECT lv.patient_id, date_sample_examination AS samp_date,
              hcv_genotype_done, hg.hcv_genotype,
              hgs.hcv_genotype_sub_type,
              fibroscan_staging_category AS fib_score,
              child_pugh_score AS child_pugh
        FROM public."3_lab_virology_lab_virologie" AS lv
        LEFT JOIN hcv_genotype AS hg
          ON lv.patient_id = hg.patient_id
        LEFT JOIN hcv_genotype_sub_type AS hgs
          ON lv.patient_id = hgs.patient_id;'),
  
  # * HCV treatment data ----
  list("hcv_treatment",
       'SELECT  clin.patient_id, visit_date, treatment_status_today AS tx_status,
                decision_on_treatment_care AS tx_decision,
                px.hcv_treatment_prescribed AS tx_prescribed
        FROM public."4_clin_assess_treat_hcv_éval_clin_trait_vhc" AS clin
        LEFT JOIN public.hcv_treatment_prescribed as px
          ON clin.patient_id = px.patient_id;'),
  
  # * HCV end and outcome ----
  list("hcv_end",
       'SELECT patient_id, end_of_treatment_date AS end_date,
		        outcome_this_course AS outcome,
		        final_end_of_followup AS end_fu,
		        reason_end_of_followup AS end_fu_reason
        FROM public."6_treatment_outcome_hcv_issue_du_traitement_vhc"
        WHERE end_of_treatment_date IS NOT NULL
                            OR outcome_this_course IS NOT NULL;')
)


# data frame of names and PostgreSQL commands
hcv_commands <- purrr::map(hcv_queries, .f = ~new_command(.x[[1]], .x[[2]])) %>% 
  dplyr::bind_rows()

# TB factor levels ----

tb_levels <- list(
  var_names = c("regimen", "tb_reg_grp", "mtb_confirmation",
                "dst_sub_profile", "out_regimen", "outcome"),
  var_levels = list(
    c(
      "Only 1st line drugs",
      "Regimen including 2nd line drugs",
      "Not defined"
    ),
    c(
      "New",
      "Relapse",
      "Treatment after loss to followup",
      "Treatment After Failure",
      "Other previously treated patients"
    ),
    c(
      "Non-confirmed, clinically diagnosed",
      "Bacteriologically Confirmed"
    ),
    c(
      "H(S) resistance",
      "HE(S) resistance",
      "R resistance with H susceptibility",
      "GeneXpert RIF resistance only",
      "Confirmed MDR",
      "Confirmed pre-XDR (FQ)",
      "Confirmed pre-XDR (Inj)",
      "Confirmed XDR",
      "Other"
    ),
    c("DS-TB",
      "DR-TB"), 
    c(
      "Cured",
      "Completed",
      "Died",
      "Failed",
      "LTFU",
      "Not Evaluated",
      "Treatment adapted"
    )
  )
)

# HIV factor levels ----
hiv_levels <- list(
  var_names = c("regimen_type", 
                "who_stage"),
  var_levels = list(
    c("HIV 1st line", 
      "HIV 2nd line", 
      "HIV 3rd line", 
      "Not defined"
      ), 
    c("WHO stage 1", 
      "WHO stage 2",
      "WHO stage 3",
      "WHO stage 4",
      "Unknown"
      )
  ),
  status_levels = c(
    "HIV 1st line",
    "HIV 2nd line",
    "HIV 3rd line",
    "Death",
    "Transfer out",
    "Declared lost to follow-up",
    "Returned to care after previous exit"
  ),
  simple_status_levels = c(
    "On treatment",
    "Returned to care",
    "Death",
    "LTFU",
    "Transfer out"
  )
)


drug_formulations <- c(
  "TDF/3TC/DTG",
  "TDF/3TC/EFV",
  "TDF/3TC",
  "TDF/FTC ",
  "TDF/FTC/EFV",
  "TDF",
  "TAF",
  "ABC/3TC",
  "ABC",
  "AZT/3TC",
  "AZT/3TC/NVP",
  "AZT",
  "3TC",
  "EFV",
  "NVP",
  "ETR",
  "ATV/r",
  "LPV/r",
  "ATV",
  "DRV",
  "r",
  "DTG",
  "RAL",
  "SOF/DCV",
  "SOF",
  "DCV",
  "RBV",
  "SOF/VEL/VOX",
  "LDP/SOF",
  "SOF/VEL",
  "GLE/PIB",
  "Other"
)

core_hiv_formulations <- c(
  "TDF/3TC/DTG",
  "TDF/3TC/EFV",
  "ABC/3TC/DTG",
  "ABC/3TC/EFV",
  "TDF/3TC/ATV/r",
  "AZT/3TC/EFV",
  "Other"
)

# HCV factor levels ----

hcv_levels <- list(
  var_names = c("hcv_genotype", "hcv_genotype_sub_type", "fib_score",
                "performance_status_ecog", "outcome"),
  var_levels = list(
      c("Genotype 1",
        "Genotype 2",
        "Genotype 3",
        "Genotype 4",
        "Genotype 5",
        "Genotype 6",
        "Indeterminate",
        "Not specified"
    ),
    c("Subtype a",
      "Subtype b",
      "Subtype c",
      "Subtype d",
      "Subtype e",
      "Subtype other",
      "Not specified"
      ),
    c("F0 no fibrosis",
      "F1 mild fibrosis",
      "F2 moderate fibrosis",
      "F3 severe fibrosis",
      "F4 cirrhosis",
      "Not specified"
      ),
    c("0=Fully active",
      "1=Ambulatory",
      "2=Capable of self care",
      "3=Limited self care",
      "4=Completely disabled"
      ),
    c("Cured",
      "Completed, post treatment VL not done",
      "Died",
      "Failed",
      "LTFU during treatment",
      "Other")
  )
)

core_hcv_formulations <- list(
  "SOF/DCV", 
  "SOF/DCV/RBV",
  "SOF/VEL/VOX",
  "Other"
)

core_hcv_genotypes <- list(
  "Genotype 1",
  "Genotype 1a",
  "Genotype 1b", 
  "Genotype 2", 
  "Genytype 3",
  "Genotype 4",
  "Other"
)

# Color palettes ----
binary_colors <- c("#A0A0A0", "#EE0200")
tb_outcome_colors <- c(
  "#f66d4e",
  "#EE0200",
  "#000000",
  "#363636",
  "#6a6a6a",
  "#a4a4a4",
  "#ee0200",
  "#e2e2e2",
  "#000000"
)

hcv_outcome_colors <- c("#f66d4e",
                        "#EE0200",
                        "#000000",
                        "#363636", 
                        "#6a6a6a", 
                        "#e2e2e2", 
                        "#ee0200",
                        "#000000")

hiv_outcome_colors <- c("#a4a4a4",
                        "#6a6a6a",
                        "#000000",
                        "#f66d4e",
                        "#ee0200")

# Save internal package data ----

# save to internal package data
usethis::use_data(tb_commands, hiv_commands, hcv_commands,
                  tb_levels, hiv_levels, hcv_levels,
                  drug_formulations, core_hiv_formulations,
                  core_hcv_formulations, core_hcv_genotypes,
                  binary_colors, tb_outcome_colors, hcv_outcome_colors,
                  hiv_outcome_colors,
                  internal = TRUE,
                  overwrite = TRUE)