initial work patients seen for mmi

01_control/control_mmi.R

@@ -17,8 +17,10 @@ month_end <- "2024-08-01"
 
 # functions?
 source("./07_publication/script/functions/summarise_appointments_att.R")
+source("./07_publication/script/functions/summarise_patients_seen.R")
 source("./07_publication/script/functions/get_appointments_df.R")
 source("./07_publication/script/functions/add_sex_description.R")
+source("./07_publication/script/functions/create_plots_patients_seen.R")
 source("./02_setup/save_df_as_parquet.R")
 
 # constants?
@@ -28,8 +30,11 @@ date_range <- seq.Date(from = month_start, to = month_end, by = "month")
 
 # 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/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"))
+
+  }
+
+
+