refining patients seen script for mmi

07_publication/script/chapters/2_load_functions.R

@@ -65,3 +65,7 @@ source('./07_publication/script/functions/create_bar_chart_refs_simd.R')
 source('./07_publication/script/functions/get_forpub_refs_agesex.R')
 
 
+
+#### Functions for MMI only ----------------------------------------------------
+
+source('./07_publication/script/functions/summarise_patients_seen.R')

07_publication/script/functions/archive/summarise_appointments_att_broken.R → 07_publication/script/functions/archive/old_apps_function.R

@@ -7,7 +7,7 @@
 
 # Uses first contact appointment for reporting attendance
 
-summarise_appointments_att <- function(){
+old_apps <- function(){
 
   # create for for saving output files in
   apps_att_dir <- paste0(shorewise_pub_data_dir, "/appointments_att/")

07_publication/script/functions/summarise_patients_seen.R

@@ -21,6 +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")
 
 # get notes and wait groups for adjusted and unadjusted rtt
   pat_seen_notes <- df_pat_seen |> 
@@ -44,10 +45,17 @@ summarise_patients_seen <- function(){
              rtt_unadj > 364, "Over 52 weeks",
              default = NA_character_),
            has_adj_in_diff_rtt_group = fcase(adj_rtt_group != unadj_rtt_group, TRUE, 
-                                             default = FALSE))
+                                             default = FALSE),
+
+           first_treat_month = floor_date(first_treat_app, unit = "month")) |> 
+    filter(first_treat_month %in% date_range) |> 
+    append_quarter_ending(date_col = "first_treat_app")
+
+
+
+  #### MONTHLY -----------------------------------------------------------------
 
   pat_seen_summ_adj <- pat_seen_notes |> 
-    mutate(first_treat_month = floor_date(first_treat_app, unit = "month")) |> # should be first_treat_app but hadn't included it in rtt function
     group_by(dataset_type, hb_name, adj_rtt_group, first_treat_month) |> 
     summarise(n = n(), .groups = "drop") |> 
     group_by(dataset_type, adj_rtt_group, first_treat_month) %>% 
@@ -59,11 +67,9 @@ summarise_patients_seen <- function(){
     mutate(total = sum(n),
            perc = round(n/total*100, 1)) |> 
     ungroup() |> 
-    filter(first_treat_month %in% date_range) |> 
     save_as_parquet(path = paste0(pat_seen_dir, measure_label, "adj_wait_grp_mth"))
 
   pat_seen_summ_unadj <- pat_seen_notes |> 
-    mutate(first_treat_month = floor_date(first_treat_app, unit = "month")) |> # should be first_treat_app but hadn't included it in rtt function
     group_by(dataset_type, hb_name, unadj_rtt_group, first_treat_month) |> 
     summarise(n = n(), .groups = "drop") |> 
     group_by(dataset_type, unadj_rtt_group, first_treat_month) %>% 
@@ -75,9 +81,245 @@ summarise_patients_seen <- function(){
     mutate(total = sum(n),
            perc = round(n/total*100, 1)) |> 
     ungroup() |> 
-    filter(first_treat_month %in% date_range) |>  
     save_as_parquet(path = paste0(pat_seen_dir, measure_label, "unadj_wait_grp_mth"))
 
+
+  #### MONTHLY 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
+
+  pat_seen_summ_adj_sex <- pat_seen_demo |> 
+    group_by(dataset_type, hb_name, adj_rtt_group, first_treat_month, sex_reported) |> 
+    summarise(n = n(), .groups = "drop") |> 
+    group_by(dataset_type, adj_rtt_group, first_treat_month, sex_reported) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(hb_name, ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    group_by(dataset_type, hb_name, first_treat_month, 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_mth_sex"))
+
+  pat_seen_summ_unadj_sex <- pat_seen_demo |> 
+    group_by(dataset_type, hb_name, unadj_rtt_group, first_treat_month, sex_reported) |> 
+    summarise(n = n(), .groups = "drop") |> 
+    group_by(dataset_type, unadj_rtt_group, first_treat_month, sex_reported) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(hb_name, ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    group_by(dataset_type, hb_name, first_treat_month, 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_mth_sex"))
+
+
+# BY AGE GROUP
+
+  pat_seen_summ_adj_age <- pat_seen_demo |> 
+    group_by(dataset_type, hb_name, adj_rtt_group, first_treat_month, age_group) |> 
+    summarise(n = n(), .groups = "drop") |> 
+    group_by(dataset_type, adj_rtt_group, first_treat_month, age_group) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(hb_name, ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    group_by(dataset_type, hb_name, first_treat_month, 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_mth_age"))
+
+  pat_seen_summ_unadj_age <- pat_seen_demo |> 
+    group_by(dataset_type, hb_name, unadj_rtt_group, first_treat_month, age_group) |> 
+    summarise(n = n(), .groups = "drop") |> 
+    group_by(dataset_type, unadj_rtt_group, first_treat_month, age_group) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(hb_name, ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    group_by(dataset_type, hb_name, first_treat_month, 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_meth_age"))
+
+
+  # BY SIMD QUINTILE
+
+  pat_seen_summ_adj_simd <- pat_seen_demo |> 
+    group_by(dataset_type, hb_name, adj_rtt_group, first_treat_month, !!sym(simd_quintile_o)) |> 
+    summarise(n = n(), .groups = "drop") |> 
+    group_by(dataset_type, adj_rtt_group, first_treat_month, !!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, first_treat_month, !!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_mth_simd"))
+
+  pat_seen_summ_unadj_simd <- pat_seen_demo |> 
+    group_by(dataset_type, hb_name, unadj_rtt_group, first_treat_month, !!sym(simd_quintile_o)) |> 
+    summarise(n = n(), .groups = "drop") |> 
+    group_by(dataset_type, unadj_rtt_group, first_treat_month, !!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, first_treat_month, !!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_mth_simd"))
+
+
+  #### QUARTERLY ---------------------------------------------------------------
+
+
+  qt_pat_seen_summ_adj <- pat_seen_notes |> 
+    group_by(dataset_type, hb_name, adj_rtt_group, quarter_ending) |> 
+    summarise(n = n(), .groups = "drop") |> 
+    group_by(dataset_type, adj_rtt_group, quarter_ending) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(hb_name, ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    group_by(dataset_type, hb_name, quarter_ending) |> 
+    mutate(total = sum(n),
+           perc = round(n/total*100, 1)) |> 
+    ungroup() |> 
+    save_as_parquet(path = paste0(pat_seen_dir, measure_label, "adj_wait_grp_qt"))
+
+  qt_pat_seen_summ_unadj <- pat_seen_notes |> 
+    group_by(dataset_type, hb_name, unadj_rtt_group, quarter_ending) |> 
+    summarise(n = n(), .groups = "drop") |> 
+    group_by(dataset_type, unadj_rtt_group, quarter_ending) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(hb_name, ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    group_by(dataset_type, hb_name, quarter_ending) |> 
+    mutate(total = sum(n),
+           perc = round(n/total*100, 1)) |> 
+    ungroup() |> 
+    save_as_parquet(path = paste0(pat_seen_dir, measure_label, "unadj_wait_grp_qt"))
+
+  #### QUARTERLY BY DEMOGRAPHICS -----------------------------------------------
+
+    # BY SEX
+
+    qt_pat_seen_summ_adj_sex <- pat_seen_demo |> 
+      group_by(dataset_type, hb_name, adj_rtt_group, quarter_ending, sex_reported) |> 
+      summarise(n = n(), .groups = "drop") |> 
+      group_by(dataset_type, adj_rtt_group, quarter_ending, sex_reported) %>% 
+      bind_rows(summarise(.,
+                          across(where(is.numeric), sum),
+                          across(hb_name, ~"NHS Scotland"),
+                          .groups = "drop")) |> 
+      group_by(dataset_type, hb_name, quarter_ending, 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_qt_sex"))
+
+    qt_pat_seen_summ_unadj_sex <- pat_seen_demo |> 
+      group_by(dataset_type, hb_name, unadj_rtt_group, quarter_ending, sex_reported) |> 
+      summarise(n = n(), .groups = "drop") |> 
+      group_by(dataset_type, unadj_rtt_group, quarter_ending, sex_reported) %>% 
+      bind_rows(summarise(.,
+                          across(where(is.numeric), sum),
+                          across(hb_name, ~"NHS Scotland"),
+                          .groups = "drop")) |> 
+      group_by(dataset_type, hb_name, quarter_ending, 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_qt_sex"))
+
+
+    # BY AGE GROUP
+
+    qt_pat_seen_summ_adj_age <- pat_seen_demo |> 
+      group_by(dataset_type, hb_name, adj_rtt_group, quarter_ending, age_group) |> 
+      summarise(n = n(), .groups = "drop") |> 
+      group_by(dataset_type, adj_rtt_group, quarter_ending, age_group) %>% 
+      bind_rows(summarise(.,
+                          across(where(is.numeric), sum),
+                          across(hb_name, ~"NHS Scotland"),
+                          .groups = "drop")) |> 
+      group_by(dataset_type, hb_name, quarter_ending, 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_qt_age"))
+
+    qt_pat_seen_summ_unadj_age <- pat_seen_demo |> 
+      group_by(dataset_type, hb_name, unadj_rtt_group, quarter_ending, age_group) |> 
+      summarise(n = n(), .groups = "drop") |> 
+      group_by(dataset_type, unadj_rtt_group, quarter_ending, age_group) %>% 
+      bind_rows(summarise(.,
+                          across(where(is.numeric), sum),
+                          across(hb_name, ~"NHS Scotland"),
+                          .groups = "drop")) |> 
+      group_by(dataset_type, hb_name, quarter_ending, 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_qt_age"))
+
+
+    # BY SIMD QUINTILE
+
+    qt_pat_seen_summ_adj_simd <- pat_seen_demo |> 
+      group_by(dataset_type, hb_name, adj_rtt_group, quarter_ending, !!sym(simd_quintile_o)) |> 
+      summarise(n = n(), .groups = "drop") |> 
+      group_by(dataset_type, adj_rtt_group, quarter_ending, !!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, quarter_ending, !!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_qt_simd"))
+
+    qt_pat_seen_summ_unadj_simd <- pat_seen_demo |> 
+      group_by(dataset_type, hb_name, unadj_rtt_group, quarter_ending, !!sym(simd_quintile_o)) |> 
+      summarise(n = n(), .groups = "drop") |> 
+      group_by(dataset_type, unadj_rtt_group, quarter_ending, !!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, quarter_ending, !!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_qt_simd"))
+
+
   }