Merge pull request #425 from Public-Health-Scotland/bex

Bex

01_control/control_mmi.R

@@ -23,8 +23,11 @@ source("./07_publication/script/chapters/3_set_constants.R")
 
 # Step 3 - Analyse Data ---------------------------------------------------
 
-summarise_appointments_att() # key output will be "/appointments_att/apps_att_mth_hb.parquet"
-
+summarise_appointments_att() # key output "/appointments_att/apps_att_mth_hb.parquet"
+summarise_patients_seen() # key outputs "/patients_seen/pat_seen_unadj_wait_grp_mth.parquet' and "/patients_seen/pat_seen_adj_wait_grp_mth.parquet'
 
+# Step 4 - Create plots ---------------------------------------------------
 
+create_plots_patients_seen("PT")
+create_plots_patients_seen("CAMHS")
 

07_publication/script/functions/create_plots_patients_seen.R

@@ -0,0 +1,116 @@
+##############################################.
+#### Create patients seen plots - for mmi ####.
+##############################################.
+
+# Author: Bex Madden
+# Date: 2024-09-19
+
+
+create_plots_patients_seen <- function(dataset_choice){
+
+  # adjusted waiting times
+  pat_seen_summ_adj <- read_parquet(paste0(pat_seen_dir, "pat_seen_adj_wait_grp_mth.parquet"))
+
+  dates <- pat_seen_summ_adj |> # make date labels for quarters
+    select(first_treat_month) |>
+    unique() |>
+    pull()
+
+  # line plot showing % meeting 18 week standard by month
+  adj_line_plot <- pat_seen_summ_adj |> 
+    filter(first_treat_month >=  ymd(month_start),
+           adj_rtt_group == "0 to 18 weeks",
+           hb_name == "NHS Scotland",
+           dataset_type == dataset_choice) |> 
+    ggplot(aes(x = first_treat_month, y = perc)) +
+    geom_point() +
+    geom_line() +
+    scale_x_date(labels = format(dates, "%b-%y"), breaks = dates) +
+    ylim(0, 100) +# shape similar to agg
+    labs(
+      x = "\nTreatment Start Month",
+      y = "% patients seen <18 weeks",
+      caption = paste0("CAPTND extract, ", data_analysis_latest_date)) +
+    theme_bw() +
+    theme(
+      panel.grid.minor.x = element_blank(),
+      axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1)
+    )
+
+  ggsave(paste0(pat_seen_dir, "pat_seen_adj_trend_", dataset_choice, ".png"),
+         bg = "white", width = 20, height = 13, units = "cm", dpi = 300)
+
+  # bar plot showing count in each wait group
+  adj_bar_plot <- pat_seen_summ_adj |> 
+    filter(first_treat_month >=  ymd(month_start),
+           hb_name == "NHS Scotland",
+           dataset_type == dataset_choice) |> 
+    ggplot(aes(x = first_treat_month, y = n, fill = fct_rev(as_factor(adj_rtt_group)))) +
+    geom_bar(position = "stack", stat="identity") + # shape similar but number quite different to agg
+    scale_fill_discrete_phs() +
+    scale_x_date(labels = format(dates, "%b-%y"), breaks = dates) +
+    labs(
+      x = "\nTreatment Start Month",
+      y = "N patients by wait group",
+      fill = "Wait group",
+      caption = paste0("CAPTND extract, ", data_analysis_latest_date)) +
+    theme_bw() +
+    theme(
+      axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1)
+    )
+
+  ggsave(paste0(pat_seen_dir, "pat_seen_adj_bar_", dataset_choice, ".png"),
+         bg = "white", width = 20, height = 13, units = "cm", dpi = 300) #width = chart_width, height = chart_height
+
+
+  # unadjusted waiting times
+  pat_seen_summ_unadj <- read_parquet(paste0(pat_seen_dir, "pat_seen_unadj_wait_grp_mth.parquet"))
+
+  # line plot showing % meeting 18 week standard by month
+  unadj_line_plot <- pat_seen_summ_unadj |> 
+    filter(first_treat_month >=  ymd(month_start),
+           unadj_rtt_group == "0 to 18 weeks",
+           hb_name == "NHS Scotland",
+           dataset_type == dataset_choice) |> 
+    ggplot(aes(x = first_treat_month, y = perc)) +
+    geom_point() +
+    geom_line() +
+    scale_x_date(labels = format(dates, "%b-%y"), breaks = dates) +
+    ylim(0, 100) +# shape similar to agg
+    labs(
+      x = "\nTreatment Start Month",
+      y = "% patients seen <18 weeks",
+      caption = paste0("CAPTND extract, ", data_analysis_latest_date)) +
+    theme_bw() +
+    theme(
+      panel.grid.minor.x = element_blank(),
+      axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1)
+    )
+
+  ggsave(paste0(pat_seen_dir, "pat_seen_unadj_trend_", dataset_choice, ".png"),
+         bg = "white", width = 20, height = 13, units = "cm", dpi = 300)
+
+  # bar plot showing count in each wait group
+  unadj_bar_plot <- pat_seen_summ_unadj |> 
+    filter(first_treat_month >=  ymd(month_start),
+           hb_name == "NHS Scotland",
+           dataset_type == dataset_choice) |> 
+    ggplot(aes(x = first_treat_month, y = n, fill = fct_rev(as_factor(unadj_rtt_group)))) +
+    geom_bar(position="stack", stat="identity") +
+    scale_fill_discrete_phs() +
+    scale_x_date(labels = format(dates, "%b-%y"), breaks = dates) +
+    labs(
+      x = "\nTreatment Start Month",
+      y = "N patients by wait group",
+      fill = "Wait group",
+      caption = paste0("CAPTND extract, ", data_analysis_latest_date)) +
+    theme_bw() +
+    theme(
+      axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1)
+    )
+
+  ggsave(paste0(pat_seen_dir, "pat_seen_unadj_bar_", dataset_choice, ".png"),
+         bg = "white", width = 20, height = 13, units = "cm", dpi = 300)
+
+}
+

07_publication/script/functions/create_pub_function.R

@@ -27,7 +27,7 @@ create_pub_word_doc <- function(dataset_choice){
   # Render markdown document
 
   rmarkdown::render(
-    "./07_publication/update_2024_06/markdown/CAPTND_shorewise_pub.Rmd",
+    "./07_publication/script/markdown/CAPTND_shorewise_pub.Rmd",
     output_format = phstemplates::phs_report_docx(
       reference_docx = "phs-offdev-report.docx",
       cover_page = "phs-offdev-cover.docx",
@@ -42,7 +42,7 @@ create_pub_word_doc <- function(dataset_choice){
   )
 
   rmarkdown::render(
-    "./07_publication/update_2024_06/markdown/CAPTND_shorewise_pub_summary.Rmd",
+    "./07_publication/script/markdown/CAPTND_shorewise_pub_summary.Rmd",
     output_file = paste0("/PHI_conf/MentalHealth5/CAPTND/CAPTND_shorewise/output/analysis_", 
                          data_analysis_latest_date, "/shorewise_publication/report/CAPTND_publication_summary_",
                          dataset_choice, "_", month_end, ".docx")

07_publication/script/functions/summarise_appointments_att.R

@@ -212,12 +212,12 @@ summarise_appointments_att <- function(){
     mutate(!!sym(age_group_o) := as.character(!!sym(age_group_o))) |>
     group_by(!!sym(dataset_type_o), !!sym(hb_name_o), Attendance, 
              app_quarter_ending, !!sym(age_group_o)) |> 
+    summarise(firstcon_att = n(), .groups = "drop") |> 
     group_by(!!sym(dataset_type_o), Attendance, app_quarter_ending, !!sym(age_group_o)) %>%
     bind_rows(summarise(.,
                         across(where(is.numeric), sum),
                         across(!!sym(hb_name_o), ~"NHS Scotland"),
                         .groups = "drop")) |>
-    summarise(firstcon_att = n(), .groups = "drop") |> 
     group_by(!!sym(dataset_type_o), !!sym(hb_name_o), app_quarter_ending, 
              !!sym(age_group_o)) |> 
     mutate(first_contact = sum(firstcon_att)) |> 

07_publication/script/functions/summarise_patients_seen.R

@@ -0,0 +1,84 @@
+#################################.
+#### PATIENTS SEEN - for mmi ####.
+#################################.
+
+# Author: Bex Madden
+# Date: 2024-09-19
+
+summarise_patients_seen <- function(){
+
+  # create files for saving outputs
+  pat_seen_dir <- paste0(shorewise_pub_data_dir, "/patients_seen/")
+  dir.create(pat_seen_dir)
+
+  # measure labels
+  measure_label <- "pat_seen_" # for file names
+
+  # source rtt function
+  source("./06_calculations/calculate_adjusted_rtt_waits.R")
+
+  df <- read_parquet(paste0(root_dir,'/swift_glob_completed_rtt.parquet')) 
+
+  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))
+
+# get notes and wait groups for adjusted and unadjusted rtt
+  pat_seen_notes <- df_pat_seen |> 
+    filter(!is.na(rtt_adj),
+           !is.na(first_treat_app)) |> # ok to do?
+    mutate(has_clock_reset = fcase(ref_rec_date != clock_start, TRUE, default = FALSE),
+           has_rtt_adjustment = fcase(!is.na(rtt_adj) & rtt_unadj != rtt_adj, TRUE, default = FALSE),
+           has_unavailability = fcase(unav_opti_total >= 1, TRUE, default = FALSE),
+
+           adj_rtt_group = fcase(
+             rtt_adj >= 0 & rtt_adj <= 126, "0 to 18 weeks",
+             rtt_adj > 126 & rtt_adj <= 245, "19 to 35 weeks",
+             rtt_adj > 245 & rtt_adj <= 364, "36 to 52 weeks",
+             rtt_adj > 364, "Over 52 weeks",
+             default = NA_character_
+           ),
+           unadj_rtt_group = fcase(
+             rtt_unadj >= 0 & rtt_unadj <= 126, "0 to 18 weeks",
+             rtt_unadj > 126 & rtt_unadj <= 245, "19 to 35 weeks",
+             rtt_unadj > 245 & rtt_unadj <= 364, "36 to 52 weeks",
+             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))
+
+  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) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(hb_name, ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    group_by(dataset_type, hb_name, first_treat_month) |> 
+    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) %>% 
+    bind_rows(summarise(.,
+                        across(where(is.numeric), sum),
+                        across(hb_name, ~"NHS Scotland"),
+                        .groups = "drop")) |> 
+    group_by(dataset_type, hb_name, first_treat_month) |> 
+    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"))
+
+  }
+
+
+