patients seen refinement and excel summaries

05_data_quality/product2.R

@@ -40,7 +40,9 @@ make_product_2 <- function(df_rtt, most_recent_month_in_data) {
       mutate(total = sum(n)) %>%
       ungroup() %>%
       mutate(
-        perc = round(n / total * 100, 1),!!hb_name_o := factor(!!sym(hb_name_o), level = level_order),!!rtt_eval_o := factor(
+        perc = round(n / total * 100, 1),
+        !!hb_name_o := factor(!!sym(hb_name_o), level = level_order),
+        !!rtt_eval_o := factor(
           !!sym(rtt_eval_o),
           level = c(
             'seen - active',
@@ -71,7 +73,8 @@ make_product_2 <- function(df_rtt, most_recent_month_in_data) {
       mutate(
         rtt_general = case_when(
           str_detect(!!sym(rtt_eval_o), 'seen.*') ~ 'seen',
-          str_detect(!!sym(rtt_eval_o), '.*waiting.*') ~ 'waiting',!!sym(rtt_eval_o) %in% c('referral pending', 'referral not accepted') ~ 'referral not accepted',
+          str_detect(!!sym(rtt_eval_o), '.*waiting.*') ~ 'waiting',
+          !!sym(rtt_eval_o) %in% c('referral pending', 'referral not accepted') ~ 'referral not accepted',
           str_detect(!!sym(rtt_eval_o), 'closed') ~ 'closed before seen',
           str_detect(!!sym(rtt_eval_o), 'not possible') ~ 'rtt not possible'
         )

07_publication/script/functions/compile_pat_seen_adj_excel_summary.R

@@ -0,0 +1,64 @@
+
+##########################################.
+### Compile appointments excel summary ###
+##########################################.
+
+# Author: Bex Madden
+# Date: 2024-07-23
+
+
+compile_pat_seen_adj_summary <- function(){
+
+  # get file names
+  #filnames <- list.files(ref_dir)
+
+  #  load parquet files 
+  p1 <- read_parquet(paste0(pat_seen_dir, "adj_wait_grp_all.parquet"))
+  p2 <- read_parquet(paste0(pat_seen_dir, "adj_wait_grp_all_sex.parquet"))
+  p3 <- read_parquet(paste0(pat_seen_dir, "adj_wait_grp_all_age.parquet"))
+  p4 <- read_parquet(paste0(pat_seen_dir, "adj_wait_grp_all_simd.parquet"))
+
+  p5 <- read_parquet(paste0(pat_seen_dir, "adj_wait_grp_mth.parquet"))
+  p6 <- read_parquet(paste0(pat_seen_dir, "adj_wait_grp_mth_sex.parquet"))
+  p7 <- read_parquet(paste0(pat_seen_dir, "adj_wait_grp_mth_age.parquet"))
+  p8 <- read_parquet(paste0(pat_seen_dir, "adj_wait_grp_mth_simd.parquet"))
+
+  p9 <- read_parquet(paste0(pat_seen_dir, "adj_wait_grp_qt.parquet"))
+  p10 <- read_parquet(paste0(pat_seen_dir, "adj_wait_grp_qt_sex.parquet"))
+  p11 <- read_parquet(paste0(pat_seen_dir, "adj_wait_grp_qt_age.parquet"))
+  p12 <- read_parquet(paste0(pat_seen_dir, "adj_wait_grp_qt_simd.parquet"))
+
+  # name tabs
+  list_tabs <- list(
+    all_hb = p1,
+    all_sex = p2,
+    all_age = p3,
+    all_simd = p4,
+
+    month_hb = p5,
+    month_sex = p6,
+    month_age = p7,
+    month_simd = p8,
+
+    quart_hb = p9,
+    quart_sex = p10,
+    quart_age = p11,
+    quart_simd = p12)
+
+  # save output as excel doc
+  filepath = paste0(shorewise_pub_measure_summaries_dir, "/patients_seen_adjusted_summary.xlsx")
+  export(list_tabs, file = filepath)
+
+  # format report
+  wb <- loadWorkbook(filepath)
+
+  for(i in 1:length(list_tabs)){
+    setColWidths(wb, sheet = i, cols = 1:9, widths = "auto")
+  }
+
+  saveWorkbook(wb, filepath, overwrite =TRUE)
+
+}
+
+
+

07_publication/script/functions/compile_pat_seen_unadj_excel_summary.R

@@ -0,0 +1,64 @@
+
+##########################################.
+### Compile appointments excel summary ###
+##########################################.
+
+# Author: Bex Madden
+# Date: 2024-07-23
+
+
+compile_pat_seen_unadj_summary <- function(){
+
+  # get file names
+  #filnames <- list.files(ref_dir)
+
+  #  load parquet files 
+  p1 <- read_parquet(paste0(pat_seen_dir, "unadj_wait_grp_all.parquet"))
+  p2 <- read_parquet(paste0(pat_seen_dir, "unadj_wait_grp_all_sex.parquet"))
+  p3 <- read_parquet(paste0(pat_seen_dir, "unadj_wait_grp_all_age.parquet"))
+  p4 <- read_parquet(paste0(pat_seen_dir, "unadj_wait_grp_all_simd.parquet"))
+
+  p5 <- read_parquet(paste0(pat_seen_dir, "unadj_wait_grp_mth.parquet"))
+  p6 <- read_parquet(paste0(pat_seen_dir, "unadj_wait_grp_mth_sex.parquet"))
+  p7 <- read_parquet(paste0(pat_seen_dir, "unadj_wait_grp_mth_age.parquet"))
+  p8 <- read_parquet(paste0(pat_seen_dir, "unadj_wait_grp_mth_simd.parquet"))
+
+  p9 <- read_parquet(paste0(pat_seen_dir, "unadj_wait_grp_qt.parquet"))
+  p10 <- read_parquet(paste0(pat_seen_dir, "unadj_wait_grp_qt_sex.parquet"))
+  p11 <- read_parquet(paste0(pat_seen_dir, "unadj_wait_grp_qt_age.parquet"))
+  p12 <- read_parquet(paste0(pat_seen_dir, "unadj_wait_grp_qt_simd.parquet"))
+
+  # name tabs
+  list_tabs <- list(
+    all_hb = p1,
+    all_sex = p2,
+    all_age = p3,
+    all_simd = p4,
+
+    month_hb = p5,
+    month_sex = p6,
+    month_age = p7,
+    month_simd = p8,
+
+    quart_hb = p9,
+    quart_sex = p10,
+    quart_age = p11,
+    quart_simd = p12)
+
+  # save output as excel doc
+  filepath = paste0(shorewise_pub_measure_summaries_dir, "/patients_seen_unadjusted_summary.xlsx")
+  export(list_tabs, file = filepath)
+
+  # format report
+  wb <- loadWorkbook(filepath)
+
+  for(i in 1:length(list_tabs)){
+    setColWidths(wb, sheet = i, cols = 1:9, widths = "auto")
+  }
+
+  saveWorkbook(wb, filepath, overwrite =TRUE)
+
+}
+
+
+

07_publication/script/functions/summarise_patients_seen.R

@@ -21,7 +21,7 @@ summarise_patients_seen <- function(){
 
   df_pat_seen <- calculate_adjusted_rtt_waits(df) # apply RTT calculation to latest version of df and save output
   save_as_parquet(df = df_pat_seen, path = paste0(pat_seen_dir, "patients_seen_total_df", month_end))
-  #df_pat_seen <- read_parquet("./bex_test/wholedata_rtt_test.parquet")
+  #df_pat_seen <- read_parquet(paste0(pat_seen_dir, "patients_seen_total_df", month_end, ".parquet"))
 
 # get notes and wait groups for adjusted and unadjusted rtt
   pat_seen_notes <- df_pat_seen |> 
@@ -51,7 +51,147 @@ summarise_patients_seen <- function(){
     filter(first_treat_month %in% date_range) |> 
     append_quarter_ending(date_col = "first_treat_app")
 
-
+
+
+  #### ALL TIME ----------------------------------------------------------------
+
+  all_pat_seen_summ_adj <- pat_seen_notes |> 
+    group_by(dataset_type, hb_name, adj_rtt_group) |> 
+    summarise(n = n(), .groups = "drop") |> 
+    group_by(dataset_type, adj_rtt_group) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(hb_name, ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    group_by(dataset_type, hb_name) |> 
+    mutate(total = sum(n),
+           perc = round(n/total*100, 1)) |> 
+    ungroup() |> 
+    save_as_parquet(path = paste0(pat_seen_dir, measure_label, "adj_wait_grp_all"))
+
+  all_pat_seen_summ_unadj <- pat_seen_notes |> 
+    group_by(dataset_type, hb_name, unadj_rtt_group) |> 
+    summarise(n = n(), .groups = "drop") |> 
+    group_by(dataset_type, unadj_rtt_group) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(hb_name, ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    group_by(dataset_type, hb_name) |> 
+    mutate(total = sum(n),
+           perc = round(n/total*100, 1)) |> 
+    ungroup() |> 
+    save_as_parquet(path = paste0(pat_seen_dir, measure_label, "unadj_wait_grp_all"))
+
+  #### ALL TIME BY DEMOGRAPHICS ------------------------------------------------
+
+  #make df of demographics for joining to rtt df
+  demo_df <- df |> 
+    select(!!!syms(c(patient_id_o, ucpn_o, dataset_type_o, hb_name_o, sex_reported_o,
+                     age_at_ref_rec_o, age_group_o, simd_quintile_o))) |> 
+    lazy_dt() |> 
+    group_by(!!!syms(c(patient_id_o, ucpn_o, dataset_type_o, hb_name_o))) |> 
+    slice(1) |> 
+    ungroup() |> 
+    as.data.frame() |> 
+    add_sex_description()
+
+  pat_seen_demo <- pat_seen_notes |> 
+    left_join(demo_df, by = c("patient_id", "ucpn", "dataset_type", "hb_name"))
+
+
+  # BY SEX
+
+  all_pat_seen_summ_adj_sex <- pat_seen_demo |> 
+    group_by(dataset_type, hb_name, adj_rtt_group, sex_reported) |> 
+    summarise(n = n(), .groups = "drop") |> 
+    group_by(dataset_type, adj_rtt_group, sex_reported) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(hb_name, ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    group_by(dataset_type, hb_name, sex_reported) |> #adj_rtt_group
+    mutate(total = sum(n),
+           perc = round(n/total*100, 1)) |> 
+    ungroup() |> 
+    save_as_parquet(path = paste0(pat_seen_dir, measure_label, "adj_wait_grp_all_sex"))
+
+  all_pat_seen_summ_unadj_sex <- pat_seen_demo |> 
+    group_by(dataset_type, hb_name, unadj_rtt_group, sex_reported) |> 
+    summarise(n = n(), .groups = "drop") |> 
+    group_by(dataset_type, unadj_rtt_group, sex_reported) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(hb_name, ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    group_by(dataset_type, hb_name, sex_reported) |> #adj_rtt_group
+    mutate(total = sum(n),
+           perc = round(n/total*100, 1)) |> 
+    ungroup() |> 
+    save_as_parquet(path = paste0(pat_seen_dir, measure_label, "unadj_wait_grp_all_sex"))
+
+
+  # BY AGE GROUP
+
+  all_pat_seen_summ_adj_age <- pat_seen_demo |> 
+    group_by(dataset_type, hb_name, adj_rtt_group, age_group) |> 
+    summarise(n = n(), .groups = "drop") |> 
+    group_by(dataset_type, adj_rtt_group, age_group) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(hb_name, ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    group_by(dataset_type, hb_name, age_group) |> #adj_rtt_group
+    mutate(total = sum(n),
+           perc = round(n/total*100, 1)) |> 
+    ungroup() |> 
+    save_as_parquet(path = paste0(pat_seen_dir, measure_label, "adj_wait_grp_all_age"))
+
+  all_pat_seen_summ_unadj_age <- pat_seen_demo |> 
+    group_by(dataset_type, hb_name, unadj_rtt_group, age_group) |> 
+    summarise(n = n(), .groups = "drop") |> 
+    group_by(dataset_type, unadj_rtt_group, age_group) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(hb_name, ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    group_by(dataset_type, hb_name, age_group) |> #adj_rtt_group
+    mutate(total = sum(n),
+           perc = round(n/total*100, 1)) |> 
+    ungroup() |> 
+    save_as_parquet(path = paste0(pat_seen_dir, measure_label, "unadj_wait_grp_all_age"))
+
+
+  # BY SIMD QUINTILE
+
+  all_pat_seen_summ_adj_simd <- pat_seen_demo |> 
+    group_by(dataset_type, hb_name, adj_rtt_group, !!sym(simd_quintile_o)) |> 
+    summarise(n = n(), .groups = "drop") |> 
+    group_by(dataset_type, adj_rtt_group, !!sym(simd_quintile_o)) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(hb_name, ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    group_by(dataset_type, hb_name, !!sym(simd_quintile_o)) |> #adj_rtt_group
+    mutate(total = sum(n),
+           perc = round(n/total*100, 1)) |> 
+    ungroup() |> 
+    save_as_parquet(path = paste0(pat_seen_dir, measure_label, "adj_wait_grp_all_simd"))
+
+  all_pat_seen_summ_unadj_simd <- pat_seen_demo |> 
+    group_by(dataset_type, hb_name, unadj_rtt_group, !!sym(simd_quintile_o)) |> 
+    summarise(n = n(), .groups = "drop") |> 
+    group_by(dataset_type, unadj_rtt_group, !!sym(simd_quintile_o)) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(hb_name, ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    group_by(dataset_type, hb_name, !!sym(simd_quintile_o)) |> #adj_rtt_group
+    mutate(total = sum(n),
+           perc = round(n/total*100, 1)) |> 
+    ungroup() |> 
+    save_as_parquet(path = paste0(pat_seen_dir, measure_label, "unadj_wait_grp_all_simd"))
+
 
   #### MONTHLY -----------------------------------------------------------------
 
@@ -67,7 +207,7 @@ summarise_patients_seen <- function(){
     mutate(total = sum(n),
            perc = round(n/total*100, 1)) |> 
     ungroup() |> 
-    save_as_parquet(path = paste0(pat_seen_dir, measure_label, "adj_wait_grp_mth"))
+    save_as_parquet(path = paste0(pat_seen_dir, measure_label, "adj_wait_grp_mth")) # key output for mmi
 
   pat_seen_summ_unadj <- pat_seen_notes |> 
     group_by(dataset_type, hb_name, unadj_rtt_group, first_treat_month) |> 
@@ -81,7 +221,7 @@ summarise_patients_seen <- function(){
     mutate(total = sum(n),
            perc = round(n/total*100, 1)) |> 
     ungroup() |> 
-    save_as_parquet(path = paste0(pat_seen_dir, measure_label, "unadj_wait_grp_mth"))
+    save_as_parquet(path = paste0(pat_seen_dir, measure_label, "unadj_wait_grp_mth")) # key ouput for mmi
 
 
   #### MONTHLY BY DEMOGRAPHICS -------------------------------------------------
@@ -160,7 +300,7 @@ summarise_patients_seen <- function(){
     mutate(total = sum(n),
            perc = round(n/total*100, 1)) |> 
     ungroup() |> 
-  save_as_parquet(path = paste0(pat_seen_dir, measure_label, "unadj_wait_grp_meth_age"))
+  save_as_parquet(path = paste0(pat_seen_dir, measure_label, "unadj_wait_grp_mth_age"))
 
 
   # BY SIMD QUINTILE