diff --git a/01_control/control_mmi.R b/01_control/control_mmi.R index b2014263..deeaff7c 100755 --- a/01_control/control_mmi.R +++ b/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") diff --git a/07_publication/script/functions/create_plots_patients_seen.R b/07_publication/script/functions/create_plots_patients_seen.R new file mode 100644 index 00000000..869129e4 --- /dev/null +++ b/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) + +} + diff --git a/07_publication/script/functions/create_pub_function.R b/07_publication/script/functions/create_pub_function.R index ff2461a1..b807c074 100755 --- a/07_publication/script/functions/create_pub_function.R +++ b/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") diff --git a/07_publication/script/functions/summarise_appointments_att.R b/07_publication/script/functions/summarise_appointments_att.R index b2305496..63f10e13 100755 --- a/07_publication/script/functions/summarise_appointments_att.R +++ b/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)) |> diff --git a/07_publication/script/functions/summarise_patients_seen.R b/07_publication/script/functions/summarise_patients_seen.R new file mode 100644 index 00000000..ca0f6cb9 --- /dev/null +++ b/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")) + + } + + +