Merge pull request #424 from Public-Health-Scotland/charlie

Working open open cases

01_control/control_mmi.R

@@ -15,13 +15,14 @@ month_end <- "2024-08-01"
 # Step 2 - Run these scripts in sequence ----------------------------------
 # packages?
 
-# functions?
+# 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")
 
-# constants?
+# 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")

04_check_modify/d&g_ucpn_update_fix.R

@@ -0,0 +1,36 @@
+
+###########################.
+### D&G UCPN Update Fix ###
+###########################.
+
+# Author: Charlie Smith
+# Date: 2024-09-13
+
+# Issue: D&G PT moving to Morse from early October 2024, meaning that PT will adopt a UCPN. 
+# This will mean that pre-existing records' UCPNs will no longer match. Phil will
+# provide the old-style UCPN in the UPI field. 
+
+# Solution: for submission from 2024-10-24 onwards, ensure old UCPN (in UPI field)
+# for D&G pathways IF pwathway has info from prior 2024-10-24.
+
+
+# Create a test dataset to test function on:
+# ~ 
+
+df_test_data <- as.data.frame(
+
+  header_ref_date <- c("", "", "", ""),
+
+  hb_name <- c("NHS Dumfries and Galloway", "NHS Dumfries and Galloway", "NHS Dumfries and Galloway", "NHS Fife"),
+
+  dataset_type <- c("PT", "PT", "PT", "PT"),
+
+  ucpn <- c("12345", "12345", "62891", "62891"),
+
+  upi <- c("2639123", "12345", "62891", "62891"),
+
+  ref_rec_date <- c("", "", "", "")
+
+)
+
+

07_publication/script/chapters/3_set_constants.R

@@ -34,7 +34,7 @@ non_acc_action_dir <- paste0(shorewise_pub_data_dir, "/non_acceptance_action/")
 apps_att_dir <- paste0(shorewise_pub_data_dir, "/appointments_att/")
 basic_opti_dir <- paste0(shorewise_pub_data_dir, "/basic_v_opti/")
 markdown_dir <- paste0(root_dir, "/markdown/")
-
+open_dir <- paste0(shorewise_pub_data_dir, "/open_cases/")
 
 # 4 - Reference -----------------------------------------------------------
 

09_ideas_space/check_pub_figures_incomplete.R

@@ -0,0 +1,41 @@
+
+#################################.
+### Check publication figures ###
+#################################.
+
+# Author: Charlie Smith
+# Date: 2024-7-24
+
+check_publication_figs <- function(){
+
+  # Referrals
+  df_refs <- read_parquet(
+    paste0("//PHI_conf/MentalHealth5/CAPTND/CAPTND_shorewise/output/analysis_", 
+           data_analysis_latest_date, "/shorewise_publication/data/referrals/table_referrals_quarterly.parquet"))
+
+  nc <- ncol(df_refs)
+
+  df_refs <- df_refs |> 
+    select(c(1, 2, nc)) |> 
+    filter(`Health board` %in% c("NHSScotland", "NHS Scotland"))
+
+  nc <- ncol(df_refs)
+
+  # Accepted refs
+  df_acc <- read_parquet(
+    paste0("//PHI_conf/MentalHealth5/CAPTND/CAPTND_shorewise/output/analysis_", 
+           data_analysis_latest_date, "/shorewise_publication/data/non_acceptance/table_acc_rate.parquet")) |> 
+    select(c(1, 2, Total)) |> 
+    filter(`Health board` %in% c("NHSScotland", "NHS Scotland")) 
+
+
+  # check refs == total in accepted refs
+  df_check1 <- left_join(df_refs, df_acc, by = c("dataset_type", "Health board")) |> 
+    mutate(match = , Total))
+
+
+}
+
+
+
+

09_ideas_space/summarise_open_cases.R

@@ -0,0 +1,185 @@
+
+############################.
+### Calculate open cases ###
+############################.
+
+# Author: Charlie Smith
+# Date: 2024-09-19
+
+
+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
+             !!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 -----------------------------------------------------------------
+
+  # by hb
+  df_all_hb <- df_single_row |> 
+    group_by(!!sym(dataset_type_o), !!sym(hb_name_o)) |> 
+    summarise(count = n(), .groups = "drop") |>
+    group_by(!!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() |> 
+    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"))
+
+  # by sex
+  df_all_sex <- df_single_row |> 
+    group_by(!!sym(dataset_type_o), !!sym(hb_name_o), !!sym(sex_reported_o)) |> 
+    summarise(count = n(), .groups = "drop") |>
+    group_by(!!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("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"))
+
+  # by age
+  df_all_age <- df_single_row |> 
+    group_by(!!sym(dataset_type_o), !!sym(hb_name_o), !!sym(age_group_o)) |> 
+    summarise(count = n(), .groups = "drop") |>
+    group_by(!!sym(dataset_type_o), #age_at_ref_rec, 
+             !!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("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"))
+
+  # by simd
+  df_all_simd <- df_single_row |> 
+    group_by(!!sym(dataset_type_o), !!sym(hb_name_o), !!sym(simd_quintile_o)) |> 
+    summarise(count = n(), .groups = "drop") |>
+    group_by(!!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")) |> 
+    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"))
+
+
+
+
+
+  # by month ----------------------------------------------------------------
+
+  # by hb and month
+  df_month_hb <- df_single_row |> 
+    group_by(!!sym(referral_month_o), !!sym(dataset_type_o), !!sym(hb_name_o)) |> 
+    summarise(count = n(), .groups = "drop") |>
+    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) |> 
+    save_as_parquet(path = paste0(open_dir, measure_label, "month_hb")) |> 
+
+    append_quarter_ending(date_col = "referral_month") |> 
+    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) |> 
+    save_as_parquet(path = paste0(open_dir, measure_label, "quarter_hb"))
+
+
+  # by hb, month, and sex
+  df_month_hb_sex <- df_single_row |> 
+    group_by(!!sym(referral_month_o), !!sym(dataset_type_o), !!sym(hb_name_o),
+             !!sym(sex_reported_o)) |> 
+    summarise(count = n(), .groups = "drop") |>
+    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) |> 
+    save_as_parquet(path = paste0(open_dir, measure_label, "month_hb_sex")) |> 
+
+    append_quarter_ending(date_col = "referral_month") |> 
+    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) |> 
+    save_as_parquet(path = paste0(open_dir, measure_label, "quarter_hb_sex"))
+
+
+  # by hb, month, and age
+  df_month_hb_age <- df_single_row |> 
+    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)) %>% 
+    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) |> 
+    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) |> 
+    save_as_parquet(path = paste0(open_dir, measure_label, "quarter_hb_age"))
+
+
+  # by hb, month, and simd
+  df_month_hb_simd <- df_single_row |> 
+    group_by(!!sym(referral_month_o), !!sym(dataset_type_o), !!sym(hb_name_o),
+             !!sym(simd_quintile_o)) |> 
+    summarise(count = n(), .groups = "drop") |>
+    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")) |> 
+    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) |> 
+    save_as_parquet(path = paste0(open_dir, measure_label, "month_hb_simd")) |> 
+
+    append_quarter_ending(date_col = "referral_month") |> 
+    summarise_by_quarter(vec_group = c("quarter_ending", "dataset_type", "hb_name", "simd2020_quintile")) |> 
+    add_proportion_ds_hb(vec_group = c("quarter_ending", "dataset_type", "hb_name")) |> 
+    arrange(!!dataset_type_o, !!hb_name_o) |> 
+    save_as_parquet(path = paste0(open_dir, measure_label, "quarter_hb_simd"))
+
+}
+
+

10_pre_shorewise_scripts/dq_reporting/arrange_dq_df.R

@@ -9,8 +9,11 @@
 
 arrange_dq_df <- function(df){
 
+  level_order_hb2 <- setdiff(level_order_hb, "NHS Scotland")
+  level_order_hb2 <- c("NHS Scotland", test)
+
   df_arranged <- df |>  
-    mutate(hb_name = factor(hb_name, levels = level_order_hb),
+    mutate(hb_name = factor(hb_name, levels = level_order_hb2),
            variable = factor(variable, levels = vec_vars)) |>  
     arrange(header_date_month, dataset_type, hb_name, variable) |> 
     ungroup()

10_pre_shorewise_scripts/dq_reporting/create_heatmap_invalid.R

@@ -10,8 +10,7 @@ create_heatmap_invalid <- function(df, chart_value){
 
   chart_invalid_pms <- df %>% 
     filter(value == chart_value) %>% 
-    mutate(variable = fct_rev(variable),
-           hb_name = factor(hb_name, levels = level_order_hb)) %>% 
+    mutate(variable = fct_rev(variable)) %>% 
     ggplot(aes(x = hb_name, y = variable, fill = factor(prop_group))) + 
     geom_tile(width = 1, height = 1, linewidth = .25, color = "black")+ 
     geom_text(aes(label = proportion), size = 2)+

10_pre_shorewise_scripts/dq_reporting/create_heatmap_known.R

@@ -11,8 +11,7 @@ create_heatmap_known <- function(df, chart_value){
   chart_known_pms <- df |>  
     filter(#!is.na(pms) & 
              value == chart_value) |>
-    mutate(variable = fct_rev(variable),
-           hb_name = factor(hb_name, levels = level_order_hb)) |> 
+    mutate(variable = fct_rev(variable)) |> 
     ggplot(aes(x = hb_name, y = variable, fill = prop_group))+ 
     geom_tile(width = 1, height = 1, linewidth = .25, color = "black")+ 
     geom_text(aes(label = proportion), size = 2)+

10_pre_shorewise_scripts/dq_reporting/create_heatmap_missing.R

@@ -10,8 +10,7 @@ create_heatmap_missing <- function(df, chart_value){
 
   chart_missing_pms <- df %>% 
     filter(value == chart_value) %>% 
-    mutate(variable = fct_rev(variable),
-           hb_name = factor(hb_name, levels = level_order_hb)) %>% 
+    mutate(variable = fct_rev(variable)) %>% 
     ggplot(aes(x = hb_name, y = variable, fill = factor(prop_group))) + 
     geom_tile(width = 1, height = 1, linewidth = .25, color = "black")+ 
     geom_text(aes(label = proportion), size = 2)+

10_pre_shorewise_scripts/dq_reporting/create_heatmap_not_known.R

@@ -10,8 +10,7 @@ create_heatmap_not_known <- function(df, chart_value){
 
   chart_not_known_pms <- df %>% 
     filter(value == chart_value) %>% 
-    mutate(variable = fct_rev(variable),
-           hb_name = factor(hb_name, levels = level_order_hb)) %>% 
+    mutate(variable = fct_rev(variable)) %>% 
     ggplot(aes(x = hb_name, y = variable, fill = factor(prop_group))) + 
     geom_tile(width = 1, height = 1, linewidth = .25, color = "black")+ 
     geom_text(aes(label = proportion), size = 2)+

10_pre_shorewise_scripts/dq_reporting/set_constants.R

@@ -23,7 +23,7 @@ month_word_end <- date_to_month_year_words(max(vec_timeframe))
 
 vec_vars <- c("ucpn", "chi", "upi",
 
-              "sex", "dob", "ethnicity", "looked_after_c", "vet", 
+              "sex", "dob", "ethnicity", "looked_after_c", "protection", "vet", 
               "preg_perinatal_ref", "postcode", 
 
               "ref_date", "ref_rec_date", "ref_reason", "ref_acc",  "ref_rej_act",