Calculating open cases, some tweaks to control_mmi such as sourcing f…

…unctions and constants from as very similar and easier to load from one place

01_control/control_mmi.R

@@ -16,16 +16,10 @@ month_end <- "2024-08-01"
 # packages?
 
 # functions? (separate script)
-source("./07_publication/script/functions/summarise_appointments_att.R")
-source("./07_publication/script/functions/get_appointments_df.R")
-source("./07_publication/script/functions/add_sex_description.R")
-source("./02_setup/save_df_as_parquet.R")
-source("./07_publication/script/functions/tidy_age_group_order.R")
+source("./07_publication/script/chapters/2_load_functions.R")
 
 # constants?  (separate script)
-month_end <- ymd(month_end)
-month_start <- ymd(month_end) - months(14)
-date_range <- seq.Date(from = month_start, to = month_end, by = "month")
+source("./07_publication/script/chapters/3_set_constants.R")
 
 # Step 3 - Analyse Data ---------------------------------------------------
 

01_control/control_publication.R

@@ -33,7 +33,7 @@ summarise_non_acceptance_action()
 
 summarise_referrals_basic_opti()
 summarise_appointments_att()
-
+summarise_open_cases()
 
 # 4 - Compile excel workbooks ---------------------------------------------
 

07_publication/script/chapters/2_load_functions.R

@@ -20,6 +20,7 @@ source("./07_publication/script/functions/get_basic_data_referrals_df.R")
 source('./07_publication/script/functions/tidy_age_group_order.R')
 
 source('./07_publication/script/functions/summarise_referrals.R')
+source('./07_publication/script/functions/summarise_open_cases.R')
 #source('./07_publication/script/functions/referrals_by_source.R')
 source('./07_publication/script/functions/non_acceptance.R')
 source('./07_publication/script/functions/non_acceptance_reason.R')
@@ -35,7 +36,7 @@ source('./07_publication/script/functions/compile_non_acceptance_reason_summary.
 source('./07_publication/script/functions/compile_non_acceptance_action_summary.R')
 source('./07_publication/script/functions/compile_appointments_excel_summary.R')
 source('./07_publication/script/functions/compile_basic_opti_excel_summary.R')
-
+source('./07_publication/script/functions/compile_open_cases_summary.R')
 
 source('./07_publication/script/functions/create_table_referrals_quarterly.R')
 source('./07_publication/script/functions/create_table_acc_rate.R')

07_publication/script/functions/compile_open_cases_summary.R

@@ -0,0 +1,61 @@
+
+############################################.
+### Compile open cases excel summary ###
+############################################.
+
+# Author: Charlie Smith
+# Date: 2024-09-20
+
+
+compile_open_cases_summary <- function(){
+
+  # get file names
+  #filnames <- list.files(open_dir)
+
+  #  load parquet files 
+  p1 <- read_parquet(paste0(open_dir, "open_cases_all_hb.parquet"))
+  p2 <- read_parquet(paste0(open_dir, "open_cases_all_hb_sex.parquet"))
+  p3 <- read_parquet(paste0(open_dir, "open_cases_all_hb_age.parquet"))
+  p4 <- read_parquet(paste0(open_dir, "open_cases_all_hb_simd.parquet"))
+
+  p5 <- read_parquet(paste0(open_dir, "open_cases_month_hb.parquet"))
+  p6 <- read_parquet(paste0(open_dir, "open_cases_month_hb_sex.parquet"))
+  p7 <- read_parquet(paste0(open_dir, "open_cases_month_hb_age.parquet"))
+  p8 <- read_parquet(paste0(open_dir, "open_cases_month_hb_simd.parquet"))
+
+  p9 <- read_parquet(paste0(open_dir, "open_cases_quarter_hb.parquet"))
+  p10 <- read_parquet(paste0(open_dir, "open_cases_quarter_hb_sex.parquet"))
+  p11 <- read_parquet(paste0(open_dir, "open_cases_quarter_hb_age.parquet"))
+  p12 <- read_parquet(paste0(open_dir, "open_cases_quarter_hb_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, "/open_cases_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)
+
+}

09_ideas_space/summarise_open_cases.R → 07_publication/script/functions/summarise_open_cases.R

@@ -6,16 +6,19 @@
 # Author: Charlie Smith
 # Date: 2024-09-19
 
+# This is more fiddly than I anticipated. It makes sense to report monthly open cases 
+# as cumulative sums
 
-summarise_open_cases <- function(){
 
+summarise_open_cases <- function(){
+
   dir.create(open_dir)
   measure_label <- "open_cases_"
 
   # single row per individual
   df_single_row <- read_parquet(paste0(root_dir,'/swift_glob_completed_rtt.parquet')) |> 
     lazy_dt() |> 
-    filter(!!sym(referral_month_o) %in% date_range & # apply date range filter
+    filter(!!sym(referral_month_o) <= month_end & # want total to latest month end
              !!sym(rtt_eval_o) == "seen - active") |> # the same as open cases?
     group_by(!!!syms(data_keys)) |> 
     slice(1) |> 
@@ -24,6 +27,16 @@ summarise_open_cases <- function(){
     tidy_age_group_order() |> 
     as.data.frame() 
 
+  df_single_row_monthly <- read_parquet(paste0(root_dir,'/swift_glob_completed_rtt.parquet')) |> 
+    lazy_dt() |> 
+    filter(#!!sym(referral_month_o) %in% date_range & # want to apply range filter later
+             !!sym(rtt_eval_o) == "seen - active") |> # the same as open cases?
+    group_by(!!!syms(data_keys)) |> 
+    slice(1) |> 
+    ungroup() |> 
+    add_sex_description() |> 
+    tidy_age_group_order() |> 
+    as.data.frame() 
 
   # overall -----------------------------------------------------------------
 
@@ -50,7 +63,7 @@ summarise_open_cases <- function(){
                         across(where(is.numeric), sum),
                         across(!!sym(hb_name_o), ~"NHS Scotland"),
                         .groups = "drop")) |> 
-    add_proportion_ds_hb(vec_group = c("dataset_type", "hb_name")) |> 
+    #add_proportion_ds_hb(vec_group = c("dataset_type", "hb_name")) |> 
     mutate(!!sym(hb_name_o) := factor(!!sym(hb_name_o), levels = level_order_hb)) |> 
     arrange(!!dataset_type_o, !!hb_name_o) |> 
     save_as_parquet(path = paste0(open_dir, measure_label, "all_hb_sex"))
@@ -65,7 +78,7 @@ summarise_open_cases <- function(){
                         across(where(is.numeric), sum),
                         across(!!sym(hb_name_o), ~"NHS Scotland"),
                         .groups = "drop")) |>
-    add_proportion_ds_hb(vec_group = c("dataset_type", "hb_name")) |>  
+    #add_proportion_ds_hb(vec_group = c("dataset_type", "hb_name")) |>  
     mutate(!!sym(hb_name_o) := factor(!!sym(hb_name_o), levels = level_order_hb)) |> 
     arrange(!!dataset_type_o, !!hb_name_o) |> 
     save_as_parquet(path = paste0(open_dir, measure_label, "all_hb_age"))
@@ -79,7 +92,7 @@ summarise_open_cases <- function(){
                         across(where(is.numeric), sum),
                         across(!!sym(hb_name_o), ~"NHS Scotland"),
                         .groups = "drop")) |> 
-    add_proportion_ds_hb(vec_group = c("dataset_type", "hb_name")) |> 
+    #add_proportion_ds_hb(vec_group = c("dataset_type", "hb_name")) |> 
     mutate(!!sym(hb_name_o) := factor(!!sym(hb_name_o), levels = level_order_hb)) |> 
     arrange(!!dataset_type_o, !!hb_name_o) |> 
     save_as_parquet(path = paste0(open_dir, measure_label, "all_hb_simd"))
@@ -91,73 +104,82 @@ summarise_open_cases <- function(){
   # by month ----------------------------------------------------------------
 
   # by hb and month
-  df_month_hb <- df_single_row |> 
+  df_month_hb <- df_single_row_monthly |> 
     group_by(!!sym(referral_month_o), !!sym(dataset_type_o), !!sym(hb_name_o)) |> 
     summarise(count = n(), .groups = "drop") |>
+    arrange(!!sym(dataset_type_o), !!sym(hb_name_o)) |> 
+    group_by(!!sym(dataset_type_o), !!sym(hb_name_o)) |> 
+    mutate(count = cumsum(count)) |> 
+    filter(!!sym(referral_month_o) %in% date_range) |> 
     group_by(!!sym(referral_month_o), !!sym(dataset_type_o)) %>% 
     bind_rows(summarise(.,
                         across(where(is.numeric), sum),
                         across(!!sym(hb_name_o), ~"NHS Scotland"),
                         .groups = "drop")) |> 
-    #add_proportion_ds_hb(vec_group = c("referral_month", "dataset_type", "hb_name")) |> 
     mutate(!!sym(hb_name_o) := factor(!!sym(hb_name_o), levels = level_order_hb)) |> 
-    arrange(!!dataset_type_o, !!hb_name_o) |> 
+    arrange(!!sym(dataset_type_o), !!sym(hb_name_o)) |> 
     save_as_parquet(path = paste0(open_dir, measure_label, "month_hb")) |> 
-
     append_quarter_ending(date_col = "referral_month") |> 
+    group_by(quarter_ending, !!!syms(c(dataset_type_o, hb_name_o))) |> 
+    filter(!!sym(referral_month_o) == max(!!sym(referral_month_o))) |> # need last value per quarter only
     summarise_by_quarter(vec_group = c("quarter_ending", "dataset_type", "hb_name")) |> 
-    #add_proportion_ds_hb(vec_group = c("quarter_ending", "dataset_type", "hb_name")) |> 
-    arrange(!!dataset_type_o, !!hb_name_o) |> 
+    arrange(!!sym(dataset_type_o), !!sym(hb_name_o)) |> 
     save_as_parquet(path = paste0(open_dir, measure_label, "quarter_hb"))
 
 
   # by hb, month, and sex
-  df_month_hb_sex <- df_single_row |> 
+  df_month_hb_sex <- df_single_row_monthly |> 
     group_by(!!sym(referral_month_o), !!sym(dataset_type_o), !!sym(hb_name_o),
              !!sym(sex_reported_o)) |> 
     summarise(count = n(), .groups = "drop") |>
+    arrange(!!sym(dataset_type_o), !!sym(hb_name_o), !!sym(sex_reported_o)) |> 
+    group_by(!!sym(dataset_type_o), !!sym(hb_name_o), !!sym(sex_reported_o)) |> 
+    mutate(count = cumsum(count)) |> 
+    filter(!!sym(referral_month_o) %in% date_range) |> 
     group_by(!!sym(referral_month_o), !!sym(dataset_type_o), !!sym(sex_reported_o)) %>% 
     bind_rows(summarise(.,
                         across(where(is.numeric), sum),
                         across(!!sym(hb_name_o), ~"NHS Scotland"),
                         .groups = "drop")) |> 
-    add_proportion_ds_hb(vec_group = c("referral_month", "dataset_type", "hb_name")) |> 
     mutate(!!sym(hb_name_o) := factor(!!sym(hb_name_o), levels = level_order_hb)) |> 
-    arrange(!!dataset_type_o, !!hb_name_o) |> 
+    arrange(!!sym(dataset_type_o), !!sym(hb_name_o), !!sym(sex_reported_o)) |> 
     save_as_parquet(path = paste0(open_dir, measure_label, "month_hb_sex")) |> 
-
     append_quarter_ending(date_col = "referral_month") |> 
+    ungroup() |> 
+    group_by(quarter_ending, !!!syms(c(dataset_type_o, hb_name_o, sex_reported_o))) |> 
+    filter(!!sym(referral_month_o) == max(!!sym(referral_month_o))) |> # need last value per quarter only
     summarise_by_quarter(vec_group = c("quarter_ending", "dataset_type", "hb_name", "sex_reported")) |> 
-    add_proportion_ds_hb(vec_group = c("quarter_ending", "dataset_type", "hb_name")) |> 
-    arrange(!!dataset_type_o, !!hb_name_o) |> 
+    arrange(!!sym(dataset_type_o), !!sym(hb_name_o), !!sym(sex_reported_o)) |>
     save_as_parquet(path = paste0(open_dir, measure_label, "quarter_hb_sex"))
 
 
   # by hb, month, and age
-  df_month_hb_age <- df_single_row |> 
+  df_month_hb_age <- df_single_row_monthly |> 
     group_by(!!sym(referral_month_o), !!sym(dataset_type_o), !!sym(hb_name_o), #age_at_ref_rec, 
              !!sym(age_group_o)) |> 
     summarise(count = n(), .groups = "drop") |>
-    group_by(!!sym(referral_month_o), !!sym(dataset_type_o), #age_at_ref_rec, 
-             !!sym(age_group_o)) %>% 
+    arrange(!!sym(dataset_type_o), !!sym(hb_name_o), !!sym(age_group_o)) |> 
+    group_by(!!sym(dataset_type_o), !!sym(hb_name_o), !!sym(age_group_o)) |> 
+    mutate(count = cumsum(count)) |> 
+    filter(!!sym(referral_month_o) %in% date_range) |> 
+    group_by(!!sym(referral_month_o), !!sym(dataset_type_o), !!sym(age_group_o)) %>% 
     bind_rows(summarise(.,
                         across(where(is.numeric), sum),
                         across(!!sym(hb_name_o), ~"NHS Scotland"),
                         .groups = "drop")) |> 
-    add_proportion_ds_hb(vec_group = c("referral_month", "dataset_type", "hb_name"#,"age_at_ref_rec"
-    )) |> 
     mutate(!!sym(hb_name_o) := factor(!!sym(hb_name_o), levels = level_order_hb)) |> 
-    arrange(!!dataset_type_o, !!hb_name_o) |> 
+    arrange(!!sym(dataset_type_o), !!sym(hb_name_o), !!sym(age_group_o)) |> 
     save_as_parquet(path = paste0(open_dir, measure_label, "month_hb_age")) |> 
-
     append_quarter_ending(date_col = "referral_month") |> 
-    summarise_by_quarter(vec_group = c("quarter_ending", "dataset_type", "hb_name", #"age_at_ref_rec", 
-                                       "age_group")) |> 
-    add_proportion_ds_hb(vec_group = c("quarter_ending", "dataset_type","hb_name"#, "age_at_ref_rec"
-    )) |> 
-    arrange(!!dataset_type_o, !!hb_name_o) |> 
+    ungroup() |> 
+    group_by(quarter_ending, !!!syms(c(dataset_type_o, hb_name_o, age_group_o))) |> 
+    filter(!!sym(referral_month_o) == max(!!sym(referral_month_o))) |> # need last value per quarter only
+    summarise_by_quarter(vec_group = c("quarter_ending", "dataset_type", "hb_name", "age_group")) |> 
+    arrange(!!sym(dataset_type_o), !!sym(hb_name_o), !!sym(age_group_o)) |>
     save_as_parquet(path = paste0(open_dir, measure_label, "quarter_hb_age"))
 
+
+
 
   # by hb, month, and simd
   df_month_hb_simd <- df_single_row |> 
@@ -180,6 +202,30 @@ summarise_open_cases <- function(){
     arrange(!!dataset_type_o, !!hb_name_o) |> 
     save_as_parquet(path = paste0(open_dir, measure_label, "quarter_hb_simd"))
 
+  df_month_hb_simd <- df_single_row_monthly |> 
+    group_by(!!sym(referral_month_o), !!sym(dataset_type_o), !!sym(hb_name_o), #age_at_ref_rec, 
+             !!sym(simd_quintile_o)) |> 
+    summarise(count = n(), .groups = "drop") |>
+    arrange(!!sym(dataset_type_o), !!sym(hb_name_o), !!sym(simd_quintile_o)) |> 
+    group_by(!!sym(dataset_type_o), !!sym(hb_name_o), !!sym(simd_quintile_o)) |> 
+    mutate(count = cumsum(count)) |> 
+    filter(!!sym(referral_month_o) %in% date_range) |> 
+    group_by(!!sym(referral_month_o), !!sym(dataset_type_o), !!sym(simd_quintile_o)) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(!!sym(hb_name_o), ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    mutate(!!sym(hb_name_o) := factor(!!sym(hb_name_o), levels = level_order_hb)) |> 
+    arrange(!!sym(dataset_type_o), !!sym(hb_name_o), !!sym(simd_quintile_o)) |> 
+    save_as_parquet(path = paste0(open_dir, measure_label, "month_hb_simd")) |> 
+    append_quarter_ending(date_col = "referral_month") |> 
+    ungroup() |> 
+    group_by(quarter_ending, !!!syms(c(dataset_type_o, hb_name_o, simd_quintile_o))) |> 
+    filter(!!sym(referral_month_o) == max(!!sym(referral_month_o))) |> # need last value per quarter only
+    summarise_by_quarter(vec_group = c("quarter_ending", "dataset_type", "hb_name", "simd2020_quintile")) |> 
+    arrange(!!sym(dataset_type_o), !!sym(hb_name_o), !!sym(simd_quintile_o)) |>
+    save_as_parquet(path = paste0(open_dir, measure_label, "quarter_hb_simd"))
+
 }