diff --git a/README.md b/README.md index e1bba4e..c4217c2 100644 --- a/README.md +++ b/README.md @@ -1,2 +1,54 @@ -# RTT_Backlog -Repository for analysis to support thought piece on RTT backlog and changes since pandemic. +TU logo + +# Referral to Treatment (RTT) Backlog +This repository contains the scripts for the analysis of how the RTT backlog has changed since the start of the pandemic. Data on RTT Pathways is published monthly by NHS England and can be found [here](https://www.england.nhs.uk/statistics/statistical-work-areas/rtt-waiting-times/). + +
+ +## Using the Repository +The repository can be cloned to re-run the analysis that has been carried out. This will also rely on updating the extracts of monthly published RTT data to include more recent months. + +
+ +## Repository Structure + +The structure of this repository is detailed below: + +``` plaintext + +├───data +├───images +└───src + ├───config + ├───outputs + ├───processing + └───sql_extraction + ├───requirements + └───visualisation + +``` + +
+ +### `data` +Where the extracts of the monthly published RTT data are saved for loading. + +### `images` +Images such as TU logos and branding to add to outputs. + +### `src` + +All code is stored in src. This is subdivided into five modules: + +1. `config`: Files for configuring the output such as the `theme.css`. +2. `data`: Extracts of the monthly published RTT data. +3. `processing`: Files for loading, cleaning and processing the RTT data. +4. `requirements`: Requirements for undertaking the analysis such as the `packages.R` script. +5. `visualisation`: Files for producing the visualisations used within the outputs. + +
+ +## Contributors +This repository has been created and developed by: + +- [Andy Wilson](https://github.com/ASW-Analyst) \ No newline at end of file diff --git a/data/data.R b/data/data.R new file mode 100644 index 0000000..3defcb6 --- /dev/null +++ b/data/data.R @@ -0,0 +1 @@ +# Placeholder for publishing data folder \ No newline at end of file diff --git a/images/TU_logo_large.png b/images/TU_logo_large.png new file mode 100644 index 0000000..3ec0dfc Binary files /dev/null and b/images/TU_logo_large.png differ diff --git a/index.html b/index.html new file mode 100644 index 0000000..a628781 --- /dev/null +++ b/index.html @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/src/config/nhs_tu_theme.css b/src/config/nhs_tu_theme.css new file mode 100644 index 0000000..85968f1 --- /dev/null +++ b/src/config/nhs_tu_theme.css @@ -0,0 +1,60 @@ +/* Cerulean Theme CSS */ + +/* Global Styles */ +body { + background-color: #fff; /* White background */ + color: #333; /* Dark text color */ + font-family: Franklin Gothic; + font-size: 11pt; + font-weight: 300 +} + +h1 { + color: #407EC9; + font-weight: 150; +} + +h2 { + color: #407EC9; + font-weight: 150; +} + +h3 { + color: #407EC9; + font-weight: 100; +} + +h4 { + color: #407EC9; + font-weight: 50 +} + +hr { + color: #407EC9; + border-color: #407EC9; +} + +/* Navbar Styles */ +.navbar { + background-color: #407EC9; /* Cerulean blue background */ + border-color: #407EC9; /* Cerulean blue border */ + color: #fff; /* White text color */ +} + +/* Button Styles */ +.btn-primary { + background-color: #407EC9; /* Cerulean blue button background */ + border-color: #407EC9; /* Cerulean blue button border */ + color: #fff; /* White text color */ +} + +/* Links Styles */ +a { + color: #407EC9; /* Cerulean blue link color */ +} + +/* Add more styles as needed */ + +.toc.float-toc { + margin-bottom: 20px; /* Adjust the margin as needed */ +} diff --git a/src/config/palette.R b/src/config/palette.R new file mode 100644 index 0000000..bee6884 --- /dev/null +++ b/src/config/palette.R @@ -0,0 +1,38 @@ + +# Wong Colorblind palette -------------------------------------------------- + +palette_wong_regions <- c("#E69F00", + "#56B4E9", + "#009E73", + "#F0E442", + "#0072B2", + "#D55E00", + "#CC79A7" + +) + +# Tol Colorblind palette -------------------------------------------------- + +palette_tol_regions <- c("#332288", + "#117733", + "#44AA99", + "#88CCEE", + "#DDCC77", + "#CC6677", + "#AA4499" +) + +# TU Palette ------------------------------------------------------------- + +palette_tu <- c("#40C1AC", + "#68D2DF", + "#6CC24A", + "#407EC9", + "#F68D2E", + "#F04E98", + "#8A1538") + + +# Select palette ---------------------------------------------------------- + +palette_region <- palette_tol_regions diff --git a/src/config/tu_ggplot_themes.R b/src/config/tu_ggplot_themes.R new file mode 100644 index 0000000..a08e8c0 --- /dev/null +++ b/src/config/tu_ggplot_themes.R @@ -0,0 +1,126 @@ + +# tu_theme_standard ------------------------------------------------------- + +theme_tu_standard <- function(hex_col, hex_text = "#ffffff") { + theme(text = element_text(family = "Franklin Gothic Book"), + strip.background = element_rect(fill = hex_col), + strip.text = element_text(colour = hex_text, size = 10), + axis.text = element_text(size = 10), + axis.text.x = element_text(angle = 45, hjust = 1), + axis.title = element_text(size = 11), + plot.title = element_text(size = 16, color = hex_col), + plot.subtitle = element_text(size = 12), + legend.position = "bottom", + legend.text = element_text(size = 8) + ) + +} + +# TU Theme White Background ----------------------------------------------- + +theme_tu_white <- function(hex_col, hex_text = "#ffffff") { + theme(text = element_text(family = "Franklin Gothic Book"), + strip.background = element_rect(fill = hex_col), + strip.text = element_text(colour = hex_text, size = 10), + axis.text = element_text(size = 10), + axis.text.x = element_text(angle = 45, hjust = 1), + axis.title = element_text(size = 11), + plot.title = element_text(size = 16, color = hex_col), + plot.subtitle = element_text(size = 12), + panel.background = element_rect(fill = "#ffffff"), + panel.grid.major.y = element_line(color = "#cecece", linewidth = 0.1), + panel.grid.minor.y = element_blank(), + axis.line = element_line(color = "#000000"), + legend.position = "bottom", + legend.text = element_text(size = 7.5) + ) + +} + +# TU Theme White Background multiple facets----------------------------------------------- + +theme_tu_white_mf <- function(hex_col, hex_text = "#ffffff") { + theme(text = element_text(family = "Franklin Gothic Book"), + strip.background = element_rect(fill = hex_col), + strip.text = element_text(colour = hex_text, size = 7), + axis.text = element_text(size = 8), + axis.text.x = element_text(angle = 45, hjust = 1), + axis.title = element_text(size = 9), + plot.title = element_text(size = 16, color = hex_col), + plot.subtitle = element_text(size = 12), + panel.background = element_rect(fill = "#ffffff"), + panel.grid.major.y = element_line(color = "#cecece", linewidth = 0.1), + panel.grid.minor.y = element_blank(), + axis.line = element_line(color = "#000000"), + legend.position = "bottom", + legend.text = element_text(size = 8) + ) + +} + +# TU Theme White Background multiple facets----------------------------------------------- + +theme_tu_white_bar_cf <- function(hex_col, hex_text = "#ffffff") { + theme(text = element_text(family = "Franklin Gothic Book"), + strip.background = element_rect(fill = hex_col), + strip.text = element_text(colour = hex_text, size = 10), + axis.text = element_text(size = 10), + axis.text.x = element_text(angle = 45, hjust = 1), + axis.title = element_text(size = 11), + plot.title = element_text(size = 16, color = hex_col), + plot.subtitle = element_text(size = 12), + panel.background = element_rect(fill = "#ffffff"), + panel.grid.major.x = element_line(color = "#cecece", linewidth = 0.1), + panel.grid.minor.x = element_blank(), + axis.line = element_line(color = "#000000"), + legend.position = "bottom", + legend.text = element_text(size = 8) + ) + +} + +# TU Theme White Background limited facets ----------------------------------------------- + +theme_tu_white_lf <- function(hex_col, hex_text = "#ffffff") { + theme(text = element_text(family = "Franklin Gothic Book"), + strip.background = element_rect(fill = hex_col), + strip.text = element_text(colour = hex_text, size = 7.3), + axis.text = element_text(size = 10), + axis.text.x = element_text(angle = 45, hjust = 1), + axis.title = element_text(size = 11), + plot.title = element_text(size = 16, color = hex_col), + plot.subtitle = element_text(size = 12), + panel.background = element_rect(fill = "#ffffff"), + panel.grid.major.y = element_line(color = "#cecece", linewidth = 0.1), + panel.grid.minor.y = element_blank(), + axis.line = element_line(color = "#000000"), + legend.position = "bottom", + legend.text = element_text(size = 8) + ) + +} + +# TU Theme White Background horizontal bar chart ----------------------------------------------- + +theme_tu_white_hbar <- function(hex_col, hex_text = "#ffffff") { + theme(text = element_text(family = "Franklin Gothic Book"), + strip.background = element_rect(fill = hex_col), + strip.text = element_text(colour = hex_text, size = 10), + axis.text = element_text(size = 10), + axis.text.x = element_text(angle = 45, hjust = 1), + axis.title = element_text(size = 11), + plot.title = element_text(size = 16, color = hex_col), + plot.subtitle = element_text(size = 12), + panel.background = element_rect(fill = "#ffffff"), + panel.grid.major.x = element_line(color = "#cecece", linewidth = 0.1), + panel.grid.minor.x = element_blank(), + axis.line = element_line(color = "#000000"), + legend.position = "bottom", + legend.text = element_text(size = 8) + ) + +} + +# selected_theme ---------------------------------------------------------- + +selected_theme <- theme_tu_white diff --git a/src/outputs/rtt_report.Rmd b/src/outputs/rtt_report.Rmd new file mode 100644 index 0000000..d39dc59 --- /dev/null +++ b/src/outputs/rtt_report.Rmd @@ -0,0 +1,243 @@ +--- +title: "Referral to Treatment Times - Backlog Analysis" +author: "Andy Wilson - NHS Transformation Unit" +date: "`r format(Sys.time(), '%d %B %Y')`" +output: + html_document: + toc: true + toc_depth: 2 + toc_float: true + toc_collapsed: true + css: ../config/nhs_tu_theme.css +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE, out.width = '100%') +library(here) + +source(paste0(here(), "/src/requirements/packages.R")) +source(paste0(here(), "/src/config/palette.R")) +source(paste0(here(), "/src/config/tu_ggplot_themes.R")) +source(paste0(here(), "/src/processing/load.R")) +source(paste0(here(), "/src/processing/features.R")) +source(paste0(here(), "/src/visualisation/total_backlog.R")) +source(paste0(here(), "/src/visualisation/long_waits.R")) +source(paste0(here(), "/src/visualisation/tfc_backlog.R")) +source(paste0(here(), "/src/outputs/text_outputs.R")) + +``` + +## Summary + +The Elective Waiting List across England has seen unprecedented growth since the start of the COVID-19 pandemic. Patients are waiting longer than ever for their treatment to start. The NHS has focussed on eradicating the longest waiting times with only limited success. Currently `r rtt_long_waiters_text[[5,5]]` pathways have been waiting more than a year for treatment. This analysis explores how the waiting list has changed since the pandemic. The key findings of the analysis are: + +* The waiting list has increased significantly since the start of the pandemic. This is also reflected in the increase in waiting times. +* The deterioration in waiting times is prevalent across all NHS England regions. +* National ambitions to eradicate long waiters has seen only a limited success. +* Gynaecology, ENT and Oral Surgery have seen the greatest deterioration in waiting times. + +
+ +## Introduction +*** + +### Background to Referral to Treatment Waiting Times +The Referral to Treatment (RTT) standard forms a key component of the [NHS Constitution](https://www.gov.uk/government/publications/the-nhs-constitution-for-england). This states that patients _"have the right to access certain services commissioned by NHS bodies within maximum waiting times, or for the NHS to take all reasonable steps to offer a range of suitable alternative providers if this is not possible"_. The maximum waiting times for elective care are **18 weeks from referral to their treatment**. + +NHS England publishes [monthly data](https://www.england.nhs.uk/statistics/statistical-work-areas/rtt-waiting-times/) on the numbers of patients commencing treatment and how long they waited. Additionally, figures on the number of patients who are still waiting for their treatment to start and how long they have been waiting are published. These pathways are referred to as **Incomplete Pathways**. The total number of these are also referred to as the _"size of the waiting list"_ or _"the RTT backlog"_. This is a helpful indicator of the capacity to deliver Elective care across England. The national target is that 92% of these Incomplete Pathways should be waiting less than 18 weeks since their referral. + +### Impact of COVID-19 on Delivery of Elective Care +To help free as much acute bed capacity across NHS hospitals at the start of the [COVID-19 pandemic](https://www.england.nhs.uk/coronavirus/wp-content/uploads/sites/52/2020/03/urgent-next-steps-on-nhs-response-to-covid-19-letter-simon-stevens.pdf) there was a pause in non-urgent Elective activity. This resulted in a significant increase in the size of the RTT waiting list. As the immediate pressures of coping with the pandemic eased, NHS England has prioritised reducing the number of long waiters. They published their **[Delivery plan for tackling the COVID-19 backlog of elective care](https://www.england.nhs.uk/coronavirus/wp-content/uploads/sites/52/2022/02/C1466-delivery-plan-for-tackling-the-covid-19-backlog-of-elective-care.pdf)** in February 2022. These include the ambitions: + +* No patients waiting longer than two years (104 weeks) by July 2022 +* No patients waiting longer than 18 months (78 weeks) by April 2023 +* No patients waiting longer than one year (52 weeks) by March 2025 + +### Aims of this analysis? +The analysis will explore: + +* How the size of the waiting list has changed since the pandemic. +* How waiting times have changed since the pandemic. +* Understand if these changes are similar across the country. +* Identify which Treatment Functions are most challenged. +* Understand if the ambitions set out for elective recovery are being met. + +
+ +## What's happened to the size of the Waiting List? +*** + +*Figure 1* below shows the size of the Incomplete Waiting list across all providers in England from April 2011 to `r recent_date`. + +#### Figure 1 + +```{r rtt_total_eng, out.height='60%', dpi = 1000} + +rtt_total_chart + +``` + +There was a steady increase in the waiting list across England up to the start of the pandemic. The waiting list rose from `r rtt_total_text[[1,4]]` million pathways in `r format(rtt_total_text[[1,1]], "%B %Y")` to `r rtt_total_text[[2,4]]` million by `r format(rtt_total_text[[2,1]], "%B %Y")`. There was an initial drop in the size of the waiting list at the start of the pandemic. This was due to fewer referrals from Primary Care as a result of pandemic restrictions. After the first lockdown the waiting list grew rapidly. The waiting list currently sits at `r rtt_total_text[[3,4]]` million by `r format(rtt_total_text[[3,1]], "%B %Y")`. This growth has taken place across all regions of the country as shown below in _Figure 2_: + +#### Figure 2 + +```{r rtt_total_reg, dpi = 1000} + +rtt_total_region_chart + +``` +Looking at *Treatment Functions* demonstrates that almost all services have seen an increase in the backlog since the pandemic. However, there is considerable difference in the scale of this increase. _Figure 3_ shows the number of Incomplete Pathways for the six services with the highest rate of growth since the start of the pandemic: + + +In this option we show the change in the total number of Incomplete Pathways with each scale being unique to the Treatment Function + +#### Figure 3 - Option 1 + +```{r rtt_tfc_backlog, dpi = 1000, out.height = '150%'} + +rtt_tfc_total_chart_select + +``` + + +In this option we show the change in the relative number of Incomplete Pathways for each Treatment Function relative to February 2020 (pre-COVID) + +#### Figure 3 - Option 2 + +```{r rtt_tfc_backlog_index, dpi = 1000, out.height = '150%'} + +rtt_tfc_total_chart_select_index + +``` + +We can see these significant increases across many Treatment Functions. `r tfc_text_1` has increased by `r tfc_text_perc_1` since February 2020 and `r tfc_text_2` saw a `r tfc_text_perc_2` increase. _Figure 4_ shows the percentage increase for all Treatment Functions. + +#### Figure 4 + +```{r rtt_tfc_backlog_change, dpi = 1000} + +rtt_tfc_total_change_chart + +``` + + +
+ +## Targeting Longest Waiters +*** +Since February 2022 there has been an emphasis on the eradication of waiting times over 52 weeks. Despite a reduction for those over 104 weeks and over 78 weeks, these haven't been eradicated. _Figure 5_ below shows the number of people waiting more than 52+, 65+, 78+ and 104+ weeks since June 2021. + +#### Figure 5 + +```{r rtt_long_waits_vol, dpi = 1000} + +rtt_total_long_waits_chart_post_line + +``` +There has been a major reduction in the number of 104+ week waiters from a peak off `r max_waiters_text[[4,3]]` to `r rtt_long_waiters_text[[8,5]]`. Whilst the 104+ week waiters were not eradicated in line with ambition of July 2022 the current position of `r rtt_long_waiters_text[[8,5]]` is suggestive of only a small number of complex pathways remaining. Similarly, for 78+ week waiters there has been a reduction from a peak of `r max_waiters_text[[3,3]]` to `r rtt_long_waiters_text[[7,5]]`. Although this reduction has plateaued since April 2023. The ambition of eradicating these long waits by April 2023 has not been achieved. The number of 52+ week waiters continued to grow to a peak of `r max_waiters_text[[1,3]]` in `r max_52_waiters_text[[1,5]]`. Although there has been a reduction with the latest position at `r rtt_long_waiters_text[[5,5]]`. Despite this, the eradication of 52+ week waiting times by March 2025 does not appear to be achievable. + +
+ +## Deteriorating Waiting Times - Shape of the Waiting List +*** + +Eliminating the longest waiting times are important for both patient experience and clinical outcomes. Studies have identified delays in treatment are associated with [reduced health gain](https://onlinelibrary.wiley.com/doi/abs/10.1002/hec.3195) from hip and knee replacement and increased [dependence on opiates and depression](https://boneandjoint.org.uk/Article/10.1302/0301-620X.105B7.BJJ-2023-0078.R1). + +However, this can’t be the sole focus in attempting to recover and stabilise elective waiting lists across England. Focussing on thresholds can also mask important changes in how long patients are having to wait for treatment. Looking at the changes to the shape of the waiting list provides a greater insight. + +_Figure 6_ below shows the median time for each incomplete pathway at the end of each month going back to April 2011. The interquartile range and the range of the 10th to 90th percentiles are overlaid. + +#### Figure 6 + +```{r rtt_total_wait_summary, dpi = 1000} + +rtt_total_weeks_chart + +``` +For most of the 2010s the waiting times across England remained stable. There was a median waiting time of 5-6 weeks although this had began to rise before the start of the pandemic. The distribution of waiting times was also reasonably stable. Although both the upper quartile and 90th percentile waiting times had increased in the three years before the pandemic. + +At the start of the pandemic there was a sudden and sharp rise in waiting times. This was driven by a significant drop in referrals into secondary care during lockdown. Since mid-2020 waiting times continued deteriorate. The median waiting time has now risen to `r rtt_quantiles_text[[1,4]]` weeks. The upper quartile waiting time currently stands at `r rtt_quantiles_text[[1,5]]` weeks and the 90th percentile is at `r rtt_quantiles_text[[1,6]]`. + +_Figure 7_ shows the changes in the _shape_ of the waiting list. The distribution of current waiting times has a longer tail than pre-pandemic: + +#### Figure 7 + +```{r rtt_shape_comp, dpi = 1000} + +rtt_waiting_list_shape_prop_overlap_chart + +``` + +This national pattern also occurs across each of the NHS England regions as shown in _Figure 8_ below: + +#### Figure 8 + +```{r rtt_total_wait_summary_region, dpi = 1000, fig.height = 5} + +rtt_total_weeks_chart_region + +``` + +The latest figures are provided in the table below: +```{r rtt_total_wait_summary_region_table, dpi = 1000} + +rtt_total_weeks_latest_table + +``` + +Increasing waiting times are seen across all Treatment Functions. This is particularly evident for surgical services such as the ones shown in _Figure 9_ below: + +#### Figure 9 + +```{r rtt_total_wait_summary_tfc, dpi = 1000, fig.height = 5} + +rtt_total_weeks_chart_tfc_selected + +``` + +The latest figures are provided in the table below: +```{r rtt_total_wait_summary_tfc_table, dpi = 1000} + +rtt_total_weeks_latest_tfc_table + +``` + +_Figure 10_ below shows each Treatment Function comparing their increase in median waiting times with the percentage increase in their waiting list size. This size of each Treatment Function represents the size of the current waiting list. This helps to identify the services with the greatest challenges to Elective recovery. Gynaecology, ENT and Oral Surgery have all seen larger increases to both waiting times and waiting list size. + +#### Figure 10 + +```{r rtt_tfc_scatter, dpi = 1000, fig.height=6} + +tfc_scatter_chart + +``` + +
+ +## Conclusions +*** + +The deterioration of elective waiting times are a concern for the NHS as: + +* Longer waiting times are associated with reduced clinical outcomes and worse patient experience. +* The ambition to eradicate the longest waiting times has not been achieved. The focus on long waiters risks masking concerning changes to the shape of the waiting list. +* The Waiting List is in a much more precarious position than before the pandemic. Future challenges to the delivery of Elective care will likely result in greater increase to waiting times. +* Services such as Gynaecology, ENT and Oral Surgery have a substantial challenge to recover the waiting list to pre-pandemic levels. + +
+ +## Datasets and Methods +*** + +### Dataset +This analysis has been undertaken on publicly available data released by NHS England. The data is published on a monthly basis and is available [here](https://www.england.nhs.uk/statistics/statistical-work-areas/rtt-waiting-times/). The dataset contains the number of Incomplete Pathways for both NHS and Independent providers split by Treatment Function and the number of weeks waited. No adjustments to the data have been made to account for months where there is missing data due to missing or erroneous provider submissions. Whilst NHS England publish [national estimates](https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2024/01/RTT-Overview-Timeseries-Including-Estimates-for-Missing-Trusts-Nov23-XLS-102K-61260.xlsx) to account for missing data, the methodology for this is not available for inclusion here. + +### Methods +At the NHS Transformation Unit, we are committed to open and transparent analysis. Therefore, this work has been undertaken using the open source programming [R](https://www.r-project.org/about.html). All the code to create this analysis is available from our [GitHub Repository](https://github.com/NHS-Transformation-Unit/RTT_Backlog). + +### Guidance and Further Reading +The links below contain helpful guidance and further reading relating to RTT standards and performance: + +* __RTT Guidance__: Guidance published by NHS England relating to the standards and interpretation of RTT rules is available [here](https://www.england.nhs.uk/rtt/). +* __RTT Published Data__: Data relating to performance against RTT waiting standards is available [here](https://www.england.nhs.uk/statistics/statistical-work-areas/rtt-waiting-times/). +* __The NHS waiting list: when will it peak?__: Analysis by the Health Foundation on exploring when the RTT Waiting List may peak can be read [here](https://www.health.org.uk/waiting-list). \ No newline at end of file diff --git a/src/outputs/rtt_report.html b/src/outputs/rtt_report.html new file mode 100644 index 0000000..677978e --- /dev/null +++ b/src/outputs/rtt_report.html @@ -0,0 +1,2391 @@ + + + + + + + + + + + + + + + +Referral to Treatment Times - Backlog Analysis + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + +
+
+
+
+
+ +
+ + + + + + + +
+

Summary

+

The Elective Waiting List across England has seen unprecedented +growth since the start of the COVID-19 pandemic. Patients are waiting +longer than ever for their treatment to start. The NHS has focussed on +eradicating the longest waiting times with only limited success. +Currently 355,412 pathways have been waiting more than a year for +treatment. This analysis explores how the waiting list has changed since +the pandemic. The key findings of the analysis are:

+
    +
  • The waiting list has increased significantly since the start of the +pandemic. This is also reflected in the increase in waiting times.
  • +
  • The deterioration in waiting times is prevalent across all NHS +England regions.
  • +
  • National ambitions to eradicate long waiters has seen only a limited +success.
  • +
  • Gynaecology, ENT and Oral Surgery have seen the greatest +deterioration in waiting times.
  • +
+


+
+
+

Introduction

+
+
+

Background to Referral to Treatment Waiting Times

+

The Referral to Treatment (RTT) standard forms a key component of the +NHS +Constitution. This states that patients “have the right to +access certain services commissioned by NHS bodies within maximum +waiting times, or for the NHS to take all reasonable steps to offer a +range of suitable alternative providers if this is not possible”. +The maximum waiting times for elective care are 18 weeks from +referral to their treatment.

+

NHS England publishes monthly +data on the numbers of patients commencing treatment and how long +they waited. Additionally, figures on the number of patients who are +still waiting for their treatment to start and how long they have been +waiting are published. These pathways are referred to as +Incomplete Pathways. The total number of these are also +referred to as the “size of the waiting list” or “the RTT +backlog”. This is a helpful indicator of the capacity to deliver +Elective care across England. The national target is that 92% of these +Incomplete Pathways should be waiting less than 18 weeks since their +referral.

+
+
+

Impact of COVID-19 on Delivery of Elective Care

+

To help free as much acute bed capacity across NHS hospitals at the +start of the COVID-19 +pandemic there was a pause in non-urgent Elective activity. This +resulted in a significant increase in the size of the RTT waiting list. +As the immediate pressures of coping with the pandemic eased, NHS +England has prioritised reducing the number of long waiters. They +published their Delivery +plan for tackling the COVID-19 backlog of elective care in +February 2022. These include the ambitions:

+
    +
  • No patients waiting longer than two years (104 weeks) by July +2022
  • +
  • No patients waiting longer than 18 months (78 weeks) by April +2023
  • +
  • No patients waiting longer than one year (52 weeks) by March +2025
  • +
+
+
+

Aims of this analysis?

+

The analysis will explore:

+
    +
  • How the size of the waiting list has changed since the +pandemic.
  • +
  • How waiting times have changed since the pandemic.
  • +
  • Understand if these changes are similar across the country.
  • +
  • Identify which Treatment Functions are most challenged.
  • +
  • Understand if the ambitions set out for elective recovery are being +met.
  • +
+


+
+
+
+

What’s happened to the size of the Waiting List?

+
+

Figure 1 below shows the size of the Incomplete Waiting list +across all providers in England from April 2011 to November 2023.

+
+

Figure 1

+

+

There was a steady increase in the waiting list across England up to +the start of the pandemic. The waiting list rose from 2.5 million +pathways in April 2011 to 4.4 million by February 2020. There was an +initial drop in the size of the waiting list at the start of the +pandemic. This was due to fewer referrals from Primary Care as a result +of pandemic restrictions. After the first lockdown the waiting list grew +rapidly. The waiting list currently sits at 7.6 million by November +2023. This growth has taken place across all regions of the country as +shown below in Figure 2:

+
+
+

Figure 2

+

+Looking at Treatment Functions demonstrates that almost all +services have seen an increase in the backlog since the pandemic. +However, there is considerable difference in the scale of this increase. +Figure 3 shows the number of Incomplete Pathways for the six +services with the highest rate of growth since the start of the +pandemic:

+

In this option we show the change in the total number of Incomplete +Pathways with each scale being unique to the Treatment Function

+
+
+

Figure 3 - Option 1

+

+

In this option we show the change in the relative number of +Incomplete Pathways for each Treatment Function relative to February +2020 (pre-COVID)

+
+
+

Figure 3 - Option 2

+

+

We can see these significant increases across many Treatment +Functions. Gynaecology Service has increased by 108.1% since February +2020 and Plastic Surgery Service saw a 99.2% increase. Figure 4 +shows the percentage increase for all Treatment Functions.

+
+
+

Figure 4

+

+


+
+
+
+

Targeting Longest Waiters

+
+

Since February 2022 there has been an emphasis on the eradication of +waiting times over 52 weeks. Despite a reduction for those over 104 +weeks and over 78 weeks, these haven’t been eradicated. Figure +5 below shows the number of people waiting more than 52+, 65+, 78+ +and 104+ weeks since June 2021.

+
+

Figure 5

+

+There has been a major reduction in the number of 104+ week waiters from +a peak off 24,424 to 227. Whilst the 104+ week waiters were not +eradicated in line with ambition of July 2022 the current position of +227 is suggestive of only a small number of complex pathways remaining. +Similarly, for 78+ week waiters there has been a reduction from a peak +of 123,969 to 11,168. Although this reduction has plateaued since April +2023. The ambition of eradicating these long waits by April 2023 has not +been achieved. The number of 52+ week waiters continued to grow to a +peak of 401,895 in September 2022. Although there has been a reduction +with the latest position at 355,412. Despite this, the eradication of +52+ week waiting times by March 2025 does not appear to be +achievable.

+


+
+
+
+

Deteriorating Waiting Times - Shape of the Waiting List

+
+

Eliminating the longest waiting times are important for both patient +experience and clinical outcomes. Studies have identified delays in +treatment are associated with reduced +health gain from hip and knee replacement and increased dependence +on opiates and depression.

+

However, this can’t be the sole focus in attempting to recover and +stabilise elective waiting lists across England. Focussing on thresholds +can also mask important changes in how long patients are having to wait +for treatment. Looking at the changes to the shape of the waiting list +provides a greater insight.

+

Figure 6 below shows the median time for each incomplete +pathway at the end of each month going back to April 2011. The +interquartile range and the range of the 10th to 90th percentiles are +overlaid.

+
+

Figure 6

+

+For most of the 2010s the waiting times across England remained stable. +There was a median waiting time of 5-6 weeks although this had began to +rise before the start of the pandemic. The distribution of waiting times +was also reasonably stable. Although both the upper quartile and 90th +percentile waiting times had increased in the three years before the +pandemic.

+

At the start of the pandemic there was a sudden and sharp rise in +waiting times. This was driven by a significant drop in referrals into +secondary care during lockdown. Since mid-2020 waiting times continued +deteriorate. The median waiting time has now risen to 14 weeks. The +upper quartile waiting time currently stands at 27 weeks and the 90th +percentile is at 41.

+

Figure 7 shows the changes in the shape of the +waiting list. The distribution of current waiting times has a longer +tail than pre-pandemic:

+
+
+

Figure 7

+

+

This national pattern also occurs across each of the NHS England +regions as shown in Figure 8 below:

+
+
+

Figure 8

+

+The latest figures are provided in the table below: + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+Region + +10th Percentile + +Lower Quartile + +Median + +Upper Quartile + +90th Percentile +
+EAST OF ENGLAND + +2 + +6 + +16 + +30 + +44 +
+LONDON + +2 + +5 + +13 + +25 + +38 +
+MIDLANDS + +2 + +6 + +15 + +28 + +42 +
+NORTH EAST AND YORKSHIRE + +1 + +4 + +11 + +23 + +36 +
+NORTH WEST + +2 + +6 + +15 + +30 + +44 +
+SOUTH EAST + +2 + +6 + +14 + +27 + +41 +
+SOUTH WEST + +1 + +5 + +13 + +26 + +41 +
+

Increasing waiting times are seen across all Treatment Functions. +This is particularly evident for surgical services such as the ones +shown in Figure 9 below:

+
+
+

Figure 9

+

+The latest figures are provided in the table below: + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+Treatment Function + +10th Percentile + +Lower Quartile + +Median + +Upper Quartile + +90th Percentile +
+100: General Surgery Service + +2 + +6 + +15 + +28 + +43 +
+110: Trauma and Orthopaedic Service + +2 + +6 + +15 + +28 + +43 +
+120: Ear Nose and Throat Service + +2 + +7 + +18 + +32 + +45 +
+140: Oral Surgery Service + +2 + +7 + +17 + +32 + +45 +
+150: Neurosurgical Service + +2 + +6 + +16 + +31 + +49 +
+502: Gynaecology Service + +2 + +6 + +16 + +30 + +44 +
+

Figure 10 below shows each Treatment Function comparing +their increase in median waiting times with the percentage increase in +their waiting list size. This size of each Treatment Function represents +the size of the current waiting list. This helps to identify the +services with the greatest challenges to Elective recovery. Gynaecology, +ENT and Oral Surgery have all seen larger increases to both waiting +times and waiting list size.

+
+
+

Figure 10

+

+


+
+
+
+

Conclusions

+
+

The deterioration of elective waiting times are a concern for the NHS +as:

+
    +
  • Longer waiting times are associated with reduced clinical outcomes +and worse patient experience.
  • +
  • The ambition to eradicate the longest waiting times has not been +achieved. The focus on long waiters risks masking concerning changes to +the shape of the waiting list.
  • +
  • The Waiting List is in a much more precarious position than before +the pandemic. Future challenges to the delivery of Elective care will +likely result in greater increase to waiting times.
  • +
  • Services such as Gynaecology, ENT and Oral Surgery have a +substantial challenge to recover the waiting list to pre-pandemic +levels.
  • +
+


+
+
+

Datasets and Methods

+
+
+

Dataset

+

This analysis has been undertaken on publicly available data released +by NHS England. The data is published on a monthly basis and is +available here. +The dataset contains the number of Incomplete Pathways for both NHS and +Independent providers split by Treatment Function and the number of +weeks waited. No adjustments to the data have been made to account for +months where there is missing data due to missing or erroneous provider +submissions. Whilst NHS England publish national +estimates to account for missing data, the methodology for this is +not available for inclusion here.

+
+
+

Methods

+

At the NHS Transformation Unit, we are committed to open and +transparent analysis. Therefore, this work has been undertaken using the +open source programming R. All the code to +create this analysis is available from our GitHub +Repository.

+
+
+

Guidance and Further Reading

+

The links below contain helpful guidance and further reading relating +to RTT standards and performance:

+
    +
  • RTT Guidance: Guidance published by NHS England +relating to the standards and interpretation of RTT rules is available +here.
  • +
  • RTT Published Data: Data relating to performance +against RTT waiting standards is available here.
  • +
  • The NHS waiting list: when will it peak?: Analysis +by the Health Foundation on exploring when the RTT Waiting List may peak +can be read here.
  • +
+
+
+ + + +
+
+ +
+ + + + + + + + + + + + + + + + diff --git a/src/outputs/text_outputs.R b/src/outputs/text_outputs.R new file mode 100644 index 0000000..2a9223b --- /dev/null +++ b/src/outputs/text_outputs.R @@ -0,0 +1,49 @@ + +# Recent Date ------------------------------------------------------------- + +recent_date <- format(max(rtt_total_chart_df$Effective_Snapshot_Date), "%B %Y") +text_min_date <- min(rtt_total$Effective_Snapshot_Date) +text_max_date <- max(rtt_total$Effective_Snapshot_Date) + +# RTT Total Backlog ------------------------------------------------------- + +rtt_total_text <- rtt_total_chart_df %>% + filter(Effective_Snapshot_Date == min(Effective_Snapshot_Date)| Effective_Snapshot_Date == "2020-02-29" | Effective_Snapshot_Date == max(Effective_Snapshot_Date)) %>% + mutate(Incomplete_Pathways_Char = format(Incomplete_Pathways, big.mark = ",")) %>% + mutate(Incomplete_Pathways_Mil = round(Incomplete_Pathways/1000000, 1)) + + +# TFC Total Backlog ------------------------------------------------------- + +rtt_total_text_tfc <- rtt_tfc_total_chart_df %>% + mutate(Effective_Snapshot_Date = as.Date(Effective_Snapshot_Date)) %>% + filter(Effective_Snapshot_Date == text_min_date| Effective_Snapshot_Date == "2020-02-29" | Effective_Snapshot_Date == text_min_date) %>% + mutate(Incomplete_Pathways_Char = format(Incomplete_Pathways, big.mark = ",")) %>% + mutate(Incomplete_Pathways_Mil = round(Incomplete_Pathways/1000000, 1)) + +tfc_text_perc_1 <- paste0(round(rtt_tfc_total_comp[[1,4]]*100,1), "%") +tfc_text_perc_2 <- paste0(round(rtt_tfc_total_comp[[2,4]]*100,1), "%") +tfc_text_1 <- substring(paste0(rtt_tfc_total_comp[[1,1]]), 6, nchar(paste0(rtt_tfc_total_comp[[1,1]]))) +tfc_text_2 <- substring(paste0(rtt_tfc_total_comp[[2,1]]), 6, nchar(paste0(rtt_tfc_total_comp[[2,1]]))) + + +# Long Waits Groups ------------------------------------------------------- + +rtt_long_waiters_text <- rtt_total_long_waiters_post %>% + filter(Effective_Snapshot_Date == as.Date("2021-06-30") | Effective_Snapshot_Date == text_max_date) %>% + mutate(Incomplete_Pathways_Char = format(Count, big.mark = ",")) + +max_waiters_text <- rtt_total_long_waiters_post %>% + group_by(Group) %>% + summarise(max = max(Count)) %>% + mutate(Incomplete_Pathways_Char = format(max, big.mark = ",")) + +max_52_waiters_text <- rtt_total_long_waiters_post %>% + filter(Group == "52+") %>% + filter(Count == max(Count)) %>% + mutate(max_date = format(Effective_Snapshot_Date, "%B %Y")) + + +# Total England Quantiles ------------------------------------------------- + +rtt_quantiles_text <- rtt_total_quantiles_summary_latest diff --git a/src/processing/features.R b/src/processing/features.R new file mode 100644 index 0000000..8e05b23 --- /dev/null +++ b/src/processing/features.R @@ -0,0 +1,297 @@ + +# Create Weeks ------------------------------------------------------------ + +rtt_total_weeks <- rtt_total_weeks %>% + mutate(weeks_int = case_when(substr(Number_Of_Weeks_Since_Referral, + nchar(Number_Of_Weeks_Since_Referral), + nchar(Number_Of_Weeks_Since_Referral)) == "+" ~ as.integer(substr(Number_Of_Weeks_Since_Referral, + 1, + nchar(Number_Of_Weeks_Since_Referral) - 1)), + TRUE ~ as.integer(substr(Number_Of_Weeks_Since_Referral, + 2, + str_locate(Number_Of_Weeks_Since_Referral,"-") - 1) + ))) %>% + mutate(weeks_chr = case_when(substr(Number_Of_Weeks_Since_Referral, + nchar(Number_Of_Weeks_Since_Referral), + nchar(Number_Of_Weeks_Since_Referral)) == "+" ~ Number_Of_Weeks_Since_Referral, + weeks_int < 10 ~ paste0("00",weeks_int), + weeks_int < 100 ~ paste0("0", weeks_int), + TRUE ~ as.character(weeks_int))) + + +rtt_tfc_weeks <- rtt_tfc_weeks %>% + mutate(weeks_int = case_when(substr(Number_Of_Weeks_Since_Referral, + nchar(Number_Of_Weeks_Since_Referral), + nchar(Number_Of_Weeks_Since_Referral)) == "+" ~ as.integer(substr(Number_Of_Weeks_Since_Referral, + 1, + nchar(Number_Of_Weeks_Since_Referral) - 1)), + TRUE ~ as.integer(substr(Number_Of_Weeks_Since_Referral, + 2, + str_locate(Number_Of_Weeks_Since_Referral,"-") - 1) + ))) %>% + mutate(weeks_chr = case_when(substr(Number_Of_Weeks_Since_Referral, + nchar(Number_Of_Weeks_Since_Referral), + nchar(Number_Of_Weeks_Since_Referral)) == "+" ~ Number_Of_Weeks_Since_Referral, + weeks_int < 10 ~ paste0("00",weeks_int), + weeks_int < 100 ~ paste0("0", weeks_int), + TRUE ~ as.character(weeks_int))) + + +# National Quantiles ------------------------------------------------------ + +rtt_total_month <- rtt_total_weeks %>% + group_by(Effective_Snapshot_Date) %>% + summarise(Total_Incomplete_Pathways = sum(Incomplete_Pathways, na.rm = TRUE)) %>% + mutate(Incomplete_Pathways_P10_Point = round(Total_Incomplete_Pathways * 0.10, 0), + Incomplete_Pathways_P25_Point = round(Total_Incomplete_Pathways * 0.25, 0), + Incomplete_Pathways_P50_Point = round(Total_Incomplete_Pathways * 0.50, 0), + Incomplete_Pathways_P75_Point = round(Total_Incomplete_Pathways * 0.75, 0), + Incomplete_Pathways_P90_Point = round(Total_Incomplete_Pathways * 0.90, 0) + ) + +rtt_total_quantiles <- rtt_total_weeks %>% + group_by(Effective_Snapshot_Date, weeks_int) %>% + summarise(Incomplete_Pathways = sum(Incomplete_Pathways, na.rm = TRUE)) %>% + mutate(Incomplete_Pathways_cumsum = cumsum(Incomplete_Pathways)) %>% + left_join(rtt_total_month, by = c("Effective_Snapshot_Date")) %>% + mutate(Incomplete_Pathways_P10 = case_when(Incomplete_Pathways_cumsum > Incomplete_Pathways_P10_Point ~ 1, + TRUE ~ 0), + Incomplete_Pathways_P25 = case_when(Incomplete_Pathways_cumsum > Incomplete_Pathways_P25_Point ~ 1, + TRUE ~ 0), + Incomplete_Pathways_P50 = case_when(Incomplete_Pathways_cumsum > Incomplete_Pathways_P50_Point ~ 1, + TRUE ~ 0), + Incomplete_Pathways_P75 = case_when(Incomplete_Pathways_cumsum > Incomplete_Pathways_P75_Point ~ 1, + TRUE ~ 0), + Incomplete_Pathways_P90 = case_when(Incomplete_Pathways_cumsum > Incomplete_Pathways_P90_Point ~ 1, + TRUE ~ 0) + ) + +rtt_total_quantiles_P10 <- rtt_total_quantiles %>% + group_by(Effective_Snapshot_Date) %>% + slice(which(Incomplete_Pathways_P10 == 1)[1]) %>% + select(c(1:2)) %>% + rename(Percentile_10 = 2) + +rtt_total_quantiles_P25 <- rtt_total_quantiles %>% + group_by(Effective_Snapshot_Date) %>% + slice(which(Incomplete_Pathways_P25 == 1)[1]) %>% + select(c(1:2)) %>% + rename(Percentile_25 = 2) + +rtt_total_quantiles_P50 <- rtt_total_quantiles %>% + group_by(Effective_Snapshot_Date) %>% + slice(which(Incomplete_Pathways_P50 == 1)[1]) %>% + select(c(1:2)) %>% + rename(Percentile_50 = 2) + +rtt_total_quantiles_P75 <- rtt_total_quantiles %>% + group_by(Effective_Snapshot_Date) %>% + slice(which(Incomplete_Pathways_P75 == 1)[1]) %>% + select(c(1:2)) %>% + rename(Percentile_75 = 2) + +rtt_total_quantiles_P90 <- rtt_total_quantiles %>% + group_by(Effective_Snapshot_Date) %>% + slice(which(Incomplete_Pathways_P90 == 1)[1]) %>% + select(c(1:2)) %>% + rename(Percentile_90 = 2) + +rtt_total_quantiles_summary <- rtt_total_quantiles_P10 %>% + left_join(rtt_total_quantiles_P25, by = c("Effective_Snapshot_Date")) %>% + left_join(rtt_total_quantiles_P50, by = c("Effective_Snapshot_Date")) %>% + left_join(rtt_total_quantiles_P75, by = c("Effective_Snapshot_Date")) %>% + left_join(rtt_total_quantiles_P90, by = c("Effective_Snapshot_Date")) + + +rtt_total_quantiles_summary_long <- rtt_total_quantiles_summary %>% + gather(Metric, Week, -c(1)) + + + +# Regional Quantiles ------------------------------------------------------ + +rtt_total_month_region <- rtt_total_weeks %>% + group_by(Region_Name, Effective_Snapshot_Date) %>% + summarise(Total_Incomplete_Pathways = sum(Incomplete_Pathways, na.rm = TRUE)) %>% + mutate(Incomplete_Pathways_P10_Point = round(Total_Incomplete_Pathways * 0.10, 0), + Incomplete_Pathways_P25_Point = round(Total_Incomplete_Pathways * 0.25, 0), + Incomplete_Pathways_P50_Point = round(Total_Incomplete_Pathways * 0.50, 0), + Incomplete_Pathways_P75_Point = round(Total_Incomplete_Pathways * 0.75, 0), + Incomplete_Pathways_P90_Point = round(Total_Incomplete_Pathways * 0.90, 0) + ) + +rtt_total_quantiles_region <- rtt_total_weeks %>% + group_by(Region_Name, Effective_Snapshot_Date, weeks_int) %>% + summarise(Incomplete_Pathways = sum(Incomplete_Pathways, na.rm = TRUE)) %>% + mutate(Incomplete_Pathways_cumsum = cumsum(Incomplete_Pathways)) %>% + left_join(rtt_total_month_region, by = c("Effective_Snapshot_Date", "Region_Name")) %>% + mutate(Incomplete_Pathways_P10 = case_when(Incomplete_Pathways_cumsum > Incomplete_Pathways_P10_Point ~ 1, + TRUE ~ 0), + Incomplete_Pathways_P25 = case_when(Incomplete_Pathways_cumsum > Incomplete_Pathways_P25_Point ~ 1, + TRUE ~ 0), + Incomplete_Pathways_P50 = case_when(Incomplete_Pathways_cumsum > Incomplete_Pathways_P50_Point ~ 1, + TRUE ~ 0), + Incomplete_Pathways_P75 = case_when(Incomplete_Pathways_cumsum > Incomplete_Pathways_P75_Point ~ 1, + TRUE ~ 0), + Incomplete_Pathways_P90 = case_when(Incomplete_Pathways_cumsum > Incomplete_Pathways_P90_Point ~ 1, + TRUE ~ 0) + ) + +rtt_total_quantiles_region_P10 <- rtt_total_quantiles_region %>% + group_by(Region_Name, Effective_Snapshot_Date) %>% + slice(which(Incomplete_Pathways_P10 == 1)[1]) %>% + select(c(1:3)) %>% + rename(Percentile_10 = 3) + +rtt_total_quantiles_region_P25 <- rtt_total_quantiles_region %>% + group_by(Region_Name, Effective_Snapshot_Date) %>% + slice(which(Incomplete_Pathways_P25 == 1)[1]) %>% + select(c(1:3)) %>% + rename(Percentile_25 = 3) + +rtt_total_quantiles_region_P50 <- rtt_total_quantiles_region %>% + group_by(Region_Name, Effective_Snapshot_Date) %>% + slice(which(Incomplete_Pathways_P50 == 1)[1]) %>% + select(c(1:3)) %>% + rename(Percentile_50 = 3) + +rtt_total_quantiles_region_P75 <- rtt_total_quantiles_region %>% + group_by(Region_Name, Effective_Snapshot_Date) %>% + slice(which(Incomplete_Pathways_P75 == 1)[1]) %>% + select(c(1:3)) %>% + rename(Percentile_75 = 3) + +rtt_total_quantiles_region_P90 <- rtt_total_quantiles_region %>% + group_by(Region_Name, Effective_Snapshot_Date) %>% + slice(which(Incomplete_Pathways_P90 == 1)[1]) %>% + select(c(1:3)) %>% + rename(Percentile_90 = 3) + + +rtt_total_quantiles_region_summary <- rtt_total_quantiles_region_P10 %>% + left_join(rtt_total_quantiles_region_P25, by = c("Effective_Snapshot_Date", "Region_Name")) %>% + left_join(rtt_total_quantiles_region_P50, by = c("Effective_Snapshot_Date", "Region_Name")) %>% + left_join(rtt_total_quantiles_region_P75, by = c("Effective_Snapshot_Date", "Region_Name")) %>% + left_join(rtt_total_quantiles_region_P90, by = c("Effective_Snapshot_Date", "Region_Name")) + +rtt_total_quantiles_region_summary_long <- rtt_total_quantiles_region_summary %>% + gather(Metric, Week, -c(1:2)) + +# TFC Quantiles ------------------------------------------------------ + +rtt_total_month_tfc <- rtt_tfc_weeks %>% + group_by(Treatment_Function_Desc, Effective_Snapshot_Date) %>% + summarise(Total_Incomplete_Pathways = sum(Incomplete_Pathways, na.rm = TRUE)) %>% + mutate(Incomplete_Pathways_P10_Point = round(Total_Incomplete_Pathways * 0.10, 0), + Incomplete_Pathways_P25_Point = round(Total_Incomplete_Pathways * 0.25, 0), + Incomplete_Pathways_P50_Point = round(Total_Incomplete_Pathways * 0.50, 0), + Incomplete_Pathways_P75_Point = round(Total_Incomplete_Pathways * 0.75, 0), + Incomplete_Pathways_P90_Point = round(Total_Incomplete_Pathways * 0.90, 0) + ) + +rtt_total_quantiles_tfc <- rtt_tfc_weeks %>% + group_by(Treatment_Function_Desc, Effective_Snapshot_Date, weeks_int) %>% + summarise(Incomplete_Pathways = sum(Incomplete_Pathways, na.rm = TRUE)) %>% + mutate(Incomplete_Pathways_cumsum = cumsum(Incomplete_Pathways)) %>% + left_join(rtt_total_month_tfc, by = c("Effective_Snapshot_Date", "Treatment_Function_Desc")) %>% + mutate(Incomplete_Pathways_P10 = case_when(Incomplete_Pathways_cumsum > Incomplete_Pathways_P10_Point ~ 1, + TRUE ~ 0), + Incomplete_Pathways_P25 = case_when(Incomplete_Pathways_cumsum > Incomplete_Pathways_P25_Point ~ 1, + TRUE ~ 0), + Incomplete_Pathways_P50 = case_when(Incomplete_Pathways_cumsum > Incomplete_Pathways_P50_Point ~ 1, + TRUE ~ 0), + Incomplete_Pathways_P75 = case_when(Incomplete_Pathways_cumsum > Incomplete_Pathways_P75_Point ~ 1, + TRUE ~ 0), + Incomplete_Pathways_P90 = case_when(Incomplete_Pathways_cumsum > Incomplete_Pathways_P90_Point ~ 1, + TRUE ~ 0) + ) + +rtt_total_quantiles_tfc_P10 <- rtt_total_quantiles_tfc %>% + group_by(Treatment_Function_Desc, Effective_Snapshot_Date) %>% + slice(which(Incomplete_Pathways_P10 == 1)[1]) %>% + select(c(1:3)) %>% + rename(Percentile_10 = 3) + +rtt_total_quantiles_tfc_P25 <- rtt_total_quantiles_tfc %>% + group_by(Treatment_Function_Desc, Effective_Snapshot_Date) %>% + slice(which(Incomplete_Pathways_P25 == 1)[1]) %>% + select(c(1:3)) %>% + rename(Percentile_25 = 3) + +rtt_total_quantiles_tfc_P50 <- rtt_total_quantiles_tfc %>% + group_by(Treatment_Function_Desc, Effective_Snapshot_Date) %>% + slice(which(Incomplete_Pathways_P50 == 1)[1]) %>% + select(c(1:3)) %>% + rename(Percentile_50 = 3) + +rtt_total_quantiles_tfc_P75 <- rtt_total_quantiles_tfc %>% + group_by(Treatment_Function_Desc, Effective_Snapshot_Date) %>% + slice(which(Incomplete_Pathways_P75 == 1)[1]) %>% + select(c(1:3)) %>% + rename(Percentile_75 = 3) + +rtt_total_quantiles_tfc_P90 <- rtt_total_quantiles_tfc %>% + group_by(Treatment_Function_Desc, Effective_Snapshot_Date) %>% + slice(which(Incomplete_Pathways_P90 == 1)[1]) %>% + select(c(1:3)) %>% + rename(Percentile_90 = 3) + + +rtt_total_quantiles_tfc_summary <- rtt_total_quantiles_tfc_P10 %>% + left_join(rtt_total_quantiles_tfc_P25, by = c("Effective_Snapshot_Date", "Treatment_Function_Desc")) %>% + left_join(rtt_total_quantiles_tfc_P50, by = c("Effective_Snapshot_Date", "Treatment_Function_Desc")) %>% + left_join(rtt_total_quantiles_tfc_P75, by = c("Effective_Snapshot_Date", "Treatment_Function_Desc")) %>% + left_join(rtt_total_quantiles_tfc_P90, by = c("Effective_Snapshot_Date", "Treatment_Function_Desc")) + +rtt_total_quantiles_tfc_summary_long <- rtt_total_quantiles_tfc_summary %>% + gather(Metric, Week, -c(1:2)) + + +# Long Waiters Percentages ------------------------------------------------ + +rtt_total_long_waiters <- rtt_total_weeks %>% + mutate(Flag_52 = case_when(weeks_int >= 52 ~ Incomplete_Pathways, + TRUE ~ 0), + Flag_65 = case_when(weeks_int >= 65 ~ Incomplete_Pathways, + TRUE ~0), + Flag_78 = case_when(weeks_int >= 78 ~ Incomplete_Pathways, + TRUE ~ 0), + Flag_104 = case_when(weeks_int >= 104 ~ Incomplete_Pathways, + TRUE ~ 0) + ) %>% + group_by(Effective_Snapshot_Date) %>% + summarise(Incomplete_Pathways = sum(Incomplete_Pathways, na.rm = TRUE), + Flag_52 = sum(Flag_52, na.rm = TRUE), + Flag_65 = sum(Flag_65, na.rm = TRUE), + Flag_78 = sum(Flag_78, na.rm = TRUE), + Flag_104 = sum(Flag_104, na.rm = TRUE)) %>% + mutate(Flag_52_Prop = Flag_52/Incomplete_Pathways, + Flag_65_Prop = Flag_65/Incomplete_Pathways, + Flag_78_Prop = Flag_78/Incomplete_Pathways, + Flag_104_Prop = Flag_104/Incomplete_Pathways) %>% + gather(Metric, Value, -c(1)) %>% + filter(Metric != "Incomplete_Pathways") %>% + mutate(Type = case_when(str_detect(Metric, "Prop") ~ "Prop", + TRUE ~ "Count")) %>% + mutate(Group = case_when(str_detect(Metric, "52") ~ "52+", + str_detect(Metric, "65") ~ "65+", + str_detect(Metric, "78") ~ "78+", + str_detect(Metric, "104") ~ "104+")) %>% + select(-c(Metric)) %>% + spread(Type, Value) %>% + mutate(Group = factor(Group, levels = c("52+", "65+", "78+", "104+"))) %>% + arrange(Effective_Snapshot_Date, Group) + +# Waiting List Shape ------------------------------------------------------ + +rtt_wls <- rtt_total_weeks %>% + filter(Effective_Snapshot_Date == "2020-02-29" | Effective_Snapshot_Date == max(Effective_Snapshot_Date)) %>% + group_by(Effective_Snapshot_Date, weeks_int) %>% + summarise(Incomplete_Pathways = sum(Incomplete_Pathways, na.rm = TRUE)) %>% + mutate(Incomplete_Pathways_Prop = Incomplete_Pathways/sum(Incomplete_Pathways)) + +rtt_wls_animate <- rtt_total_weeks %>% + filter(Effective_Snapshot_Date >= "2020-02-29") %>% + group_by(Effective_Snapshot_Date, weeks_int) %>% + summarise(Incomplete_Pathways = sum(Incomplete_Pathways, na.rm = TRUE)) %>% + mutate(Incomplete_Pathways_Prop = Incomplete_Pathways/sum(Incomplete_Pathways)) diff --git a/src/processing/load.R b/src/processing/load.R new file mode 100644 index 0000000..d10b719 --- /dev/null +++ b/src/processing/load.R @@ -0,0 +1,7 @@ + +# Load Total RTT Backlog -------------------------------------------------- + +rtt_total <- read_excel(paste0(here(), "/data/rtt_total.xlsx")) +rtt_total_weeks <- read_excel(paste0(here(), "/data/rtt_total_weeks.xlsx")) +rtt_tfc <- read_excel(paste0(here(), "/data/rtt_tfc.xlsx")) +rtt_tfc_weeks <- read_excel(paste0(here(), "/data/rtt_tfc_weeks.xlsx")) diff --git a/src/processing/sql_extraction/rtt_tfc.sql b/src/processing/sql_extraction/rtt_tfc.sql new file mode 100644 index 0000000..6f581c3 --- /dev/null +++ b/src/processing/sql_extraction/rtt_tfc.sql @@ -0,0 +1,31 @@ + +SELECT PRO.[Region_Code] + ,PRO.[Region_Name] + ,PRO.[STP_Code] as [ICB_Code] + ,PRO.[STP_Name] as [ICB_Name] + ,RTT.[Treatment_Function_Code] + ,TFC.[Treatment_Function_Desc] + ,RTT.[Effective_Snapshot_Date] + ,RTT.[Report_Period_Length] + ,SUM([Number_Of_Incomplete_Pathways]) AS [Incomplete_Pathways] + FROM [NHSE_UKHF].[RTT].[vw_Incomplete_Pathways_Provider1] AS [RTT] + + LEFT JOIN [NHSE_Reference].[dbo].[tbl_Ref_ODS_Provider_Hierarchies] as PRO + ON RTT.[Organisation_Code] = PRO.[Organisation_Code] COLLATE Latin1_General_CI_AS + + LEFT JOIN [NHSE_Reference].[dbo].[tbl_Ref_DataDic_ZZZ_TreatmentFunction] as TFC + ON RTT.[Treatment_Function_Code] = TFC.[Treatment_Function_Code] COLLATE Latin1_General_CI_AS + + WHERE RTT.[Treatment_Function_Code] != '999' + + GROUP BY PRO.[Region_Code] + ,PRO.[Region_Name] + ,PRO.[STP_Code] + ,PRO.[STP_Name] + ,RTT.[Treatment_Function_Code] + ,TFC.[Treatment_Function_Desc] + ,RTT.[Effective_Snapshot_Date] + ,RTT.[Report_Period_Length] + + ORDER BY RTT.[Effective_Snapshot_Date] + ,RTT.[Treatment_Function_Code] \ No newline at end of file diff --git a/src/processing/sql_extraction/rtt_tfc_weeks.sql b/src/processing/sql_extraction/rtt_tfc_weeks.sql new file mode 100644 index 0000000..23f4b5f --- /dev/null +++ b/src/processing/sql_extraction/rtt_tfc_weeks.sql @@ -0,0 +1,25 @@ + +SELECT RTT.[Treatment_Function_Code] + ,TFC.[Treatment_Function_Desc] + ,RTT.[Effective_Snapshot_Date] + ,RTT.[Report_Period_Length] + ,RTT.[Number_Of_Weeks_Since_Referral] + ,SUM([Number_Of_Incomplete_Pathways]) AS [Incomplete_Pathways] + FROM [NHSE_UKHF].[RTT].[vw_Incomplete_Pathways_Provider1] AS [RTT] + + LEFT JOIN [NHSE_Reference].[dbo].[tbl_Ref_ODS_Provider_Hierarchies] as PRO + ON RTT.[Organisation_Code] = PRO.[Organisation_Code] COLLATE Latin1_General_CI_AS + + LEFT JOIN [NHSE_Reference].[dbo].[tbl_Ref_DataDic_ZZZ_TreatmentFunction] as TFC + ON RTT.[Treatment_Function_Code] = TFC.[Treatment_Function_Code] COLLATE Latin1_General_CI_AS + + WHERE RTT.[Treatment_Function_Code] != '999' + + GROUP BY RTT.[Treatment_Function_Code] + ,TFC.[Treatment_Function_Desc] + ,RTT.[Effective_Snapshot_Date] + ,RTT.[Report_Period_Length] + ,RTT.[Number_Of_Weeks_Since_Referral] + + ORDER BY RTT.[Effective_Snapshot_Date] + ,RTT.[Treatment_Function_Code] \ No newline at end of file diff --git a/src/processing/sql_extraction/rtt_total.sql b/src/processing/sql_extraction/rtt_total.sql new file mode 100644 index 0000000..99e0696 --- /dev/null +++ b/src/processing/sql_extraction/rtt_total.sql @@ -0,0 +1,28 @@ + +SELECT RTT.[Organisation_Code] + ,PRO.[Organisation_Name] + ,PRO.[Region_Code] + ,PRO.[Region_Name] + ,PRO.[STP_Code] as [ICB_Code] + ,PRO.[STP_Name] as [ICB_Name] + ,RTT.[Effective_Snapshot_Date] + ,RTT.[Report_Period_Length] + ,SUM([Number_Of_Incomplete_Pathways]) AS [Incomplete_Pathways] + FROM [NHSE_UKHF].[RTT].[vw_Incomplete_Pathways_Provider1] AS [RTT] + + LEFT JOIN [NHSE_Reference].[dbo].[tbl_Ref_ODS_Provider_Hierarchies] as PRO + ON RTT.[Organisation_Code] = PRO.[Organisation_Code] COLLATE Latin1_General_CI_AS + + WHERE RTT.[Treatment_Function_Code] = '999' + + GROUP BY RTT.[Organisation_Code] + ,PRO.[Organisation_Name] + ,PRO.[Region_Code] + ,PRO.[Region_Name] + ,PRO.[STP_Code] + ,PRO.[STP_Name] + ,RTT.[Effective_Snapshot_Date] + ,RTT.[Report_Period_Length] + + ORDER BY RTT.[Organisation_Code] + ,RTT.[Effective_Snapshot_Date] \ No newline at end of file diff --git a/src/processing/sql_extraction/rtt_total_weeks.sql b/src/processing/sql_extraction/rtt_total_weeks.sql new file mode 100644 index 0000000..3b00c69 --- /dev/null +++ b/src/processing/sql_extraction/rtt_total_weeks.sql @@ -0,0 +1,25 @@ + +SELECT PRO.[Region_Code] + ,PRO.[Region_Name] + ,PRO.[STP_Code] as [ICB_Code] + ,PRO.[STP_Name] as [ICB_Name] + ,RTT.[Effective_Snapshot_Date] + ,RTT.[Report_Period_Length] + ,RTT.[Number_Of_Weeks_Since_Referral] + ,SUM([Number_Of_Incomplete_Pathways]) AS [Incomplete_Pathways] + FROM [NHSE_UKHF].[RTT].[vw_Incomplete_Pathways_Provider1] AS [RTT] + + LEFT JOIN [NHSE_Reference].[dbo].[tbl_Ref_ODS_Provider_Hierarchies] as PRO + ON RTT.[Organisation_Code] = PRO.[Organisation_Code] COLLATE Latin1_General_CI_AS + + WHERE RTT.[Treatment_Function_Code] = '999' + + GROUP BY PRO.[Region_Code] + ,PRO.[Region_Name] + ,PRO.[STP_Code] + ,PRO.[STP_Name] + ,RTT.[Effective_Snapshot_Date] + ,RTT.[Report_Period_Length] + ,RTT.[Number_Of_Weeks_Since_Referral] + + ORDER BY RTT.[Effective_Snapshot_Date] \ No newline at end of file diff --git a/src/requirements/packages.R b/src/requirements/packages.R new file mode 100644 index 0000000..ec34d13 --- /dev/null +++ b/src/requirements/packages.R @@ -0,0 +1,12 @@ +packages <- c("here", + "tidyverse", + "readxl", + "leaflet", + "markdown", + "knitr", + "scales", + "ggrepel", + "gganimate", + "kableExtra") + +lapply(packages, library, character.only=TRUE) diff --git a/src/visualisation/long_waits.R b/src/visualisation/long_waits.R new file mode 100644 index 0000000..7b56b5d --- /dev/null +++ b/src/visualisation/long_waits.R @@ -0,0 +1,102 @@ + +# Long Waiters - National ------------------------------------------------- + +rtt_total_long_waits_chart <- ggplot(rtt_total_long_waiters, aes(x = as.Date(Effective_Snapshot_Date), y = Count, fill = Group)) + + geom_area(stat = "identity") + + facet_wrap(~Group, scale = "free") + + scale_fill_manual(values = c("#afc9e9", "#6093d2", "#2d609f", "#163050"), name = "Long Wait Group") + + scale_x_date(date_breaks = c("12 months"), date_labels = "%b - %y") + + scale_y_continuous(label = comma) + + geom_vline(xintercept = as.Date("2020-03-01"), linetype = "dashed") + + annotate(geom = "label", + x = as.Date("2020-01-01"), + y = 0, + label = "Start of pandemic", + hjust = 1, + vjust = -1) + + labs(x = "Month Ending", + y = "Incomplete Pathways", + caption = "Source: Monthly RTT Published Data", + title = "Total Incomplete Pathways over 52 weeks", + subtitle = "All England") + + selected_theme(hex_col = "#40C1AC") + +rtt_total_long_waits_chart + +rtt_total_long_waiters_post <- rtt_total_long_waiters %>% + filter(Effective_Snapshot_Date > '2021-05-31') + +rtt_total_long_waiters_post_recent <- rtt_total_long_waiters_post %>% + filter(Effective_Snapshot_Date == max(Effective_Snapshot_Date)) %>% + mutate(nudge_y_amount = case_when(Group == "52+" ~ Count * -0.1, + TRUE ~ Count * 0.1)) + +rtt_total_long_waits_chart_post <- ggplot(rtt_total_long_waiters_post, aes(x = as.Date(Effective_Snapshot_Date), y = Count, fill = Group)) + + geom_area(stat = "identity", alpha = 0.7) + + geom_label_repel(data = rtt_total_long_waiters_post_recent, aes(label = Count, y = Count + nudge_y_amount)) + + facet_wrap(~Group, scale = "free") + + scale_fill_manual(values = c("#afc9e9", "#6093d2", "#2d609f", "#163050"), name = "Long Wait Group") + + scale_x_date(date_breaks = c("4 months"), date_labels = "%b - %y") + + scale_y_continuous(label = comma) + + labs(x = "Month Ending", + y = "Incomplete Pathways", + caption = "Source: Monthly RTT Published Data", + title = "Total Incomplete Pathways over 52 weeks", + subtitle = "All England") + + selected_theme(hex_col = "#40C1AC") + +rtt_total_long_waits_chart_post + + +rtt_total_long_waits_chart_post_line <- ggplot(rtt_total_long_waiters_post, aes(x = as.Date(Effective_Snapshot_Date), y = Count)) + + geom_line(col = palette_tu[4], linewidth = 1.1) + + geom_point(data = rtt_total_long_waiters_post_recent, col = palette_tu[4], size = 2) + + facet_wrap(~Group, scale = "free") + + scale_x_date(date_breaks = c("4 months"), date_labels = "%b - %y") + + scale_y_continuous(label = comma) + + labs(x = "Month Ending", + y = "Incomplete Pathways", + caption = "Source: Monthly RTT Published Data", + title = "Total Incomplete Pathways over 52 weeks", + subtitle = "All England - By Waiting Time") + + selected_theme(hex_col = "#40C1AC") + +rtt_total_long_waits_chart_post_line + + +rtt_total_long_waits_chart_prop <- ggplot(rtt_total_long_waiters, aes(x = as.Date(Effective_Snapshot_Date), y = Prop, col = Group)) + + geom_line(stat = "identity") + + facet_wrap(~Group, scale = "free") + + scale_color_manual(values = c("#afc9e9", "#6093d2", "#2d609f", "#163050"), name = "Long Wait Group") + + scale_x_date(date_breaks = c("12 months"), date_labels = "%b - %y") + + scale_y_continuous(label = percent) + + geom_vline(xintercept = as.Date("2020-03-01"), linetype = "dashed") + + annotate(geom = "label", + x = as.Date("2020-01-01"), + y = 0, + label = "Start of pandemic", + hjust = 1, + vjust = -1) + + labs(x = "Month Ending", + y = "Incomplete Pathways", + caption = "Source: Monthly RTT Published Data", + title = "Total Incomplete Pathways over 52 weeks", + subtitle = "All England") + + selected_theme(hex_col = "#40C1AC") + +rtt_total_long_waits_chart_prop + +rtt_total_long_waits_chart_prop_post <- ggplot(rtt_total_long_waiters_post, aes(x = as.Date(Effective_Snapshot_Date), y = Prop, col = Group)) + + geom_line(linewidth = 0.8) + + facet_wrap(~Group, scale = "free") + + scale_colour_manual(values = c("#afc9e9", "#6093d2", "#2d609f", "#163050"), name = "Long Wait Group") + + scale_x_date(date_breaks = c("4 months"), date_labels = "%b - %y") + + scale_y_continuous(label = percent) + + labs(x = "Month Ending", + y = "Incomplete Pathways over target weeks (%)", + caption = "Source: Monthly RTT Published Data", + title = "Total Incomplete Pathways over 52 weeks", + subtitle = "All England") + + selected_theme(hex_col = "#40C1AC") + +rtt_total_long_waits_chart_prop_post diff --git a/src/visualisation/tfc_backlog.R b/src/visualisation/tfc_backlog.R new file mode 100644 index 0000000..abc0d7b --- /dev/null +++ b/src/visualisation/tfc_backlog.R @@ -0,0 +1,196 @@ + +# TFC Total Backlog ------------------------------------------------------- + +rtt_tfc_total_chart_df <- rtt_tfc %>% + group_by(Effective_Snapshot_Date, Treatment_Function_Desc) %>% + summarise(Incomplete_Pathways = sum(Incomplete_Pathways, na.rm = TRUE)) %>% + mutate(Treatment_Function_Desc = case_when(Treatment_Function_Desc == "NULL" ~ "Other", + TRUE ~ Treatment_Function_Desc)) + +rtt_tfc_total_chart <- + ggplot(data = rtt_tfc_total_chart_df, aes(x = as.Date(Effective_Snapshot_Date), y = Incomplete_Pathways)) + + geom_line(col = "#40C1AC", linewidth = 0.8) + + scale_x_date(breaks = seq(as.Date("2011-04-01"), as.Date("2024-04-01"), by = "3 year"), date_labels = "%b - %y", expand = c(0,0)) + + scale_y_continuous(labels = comma, limits = c(0, NA)) + + geom_vline(xintercept = as.Date("2020-03-01"), linetype = "dashed") + + facet_wrap(~Treatment_Function_Desc, scales = "free_y", ncol = 4) + + labs(x = "Month Ending", + y = "Incomplete Pathways", + caption = "Source: Monthly RTT Published Data", + title = "Total Incomplete Pathways by Treatment Function", + subtitle = "All England") + + theme_tu_white_mf(hex_col = "#40C1AC") + +rtt_tfc_total_chart + +# TFC Total Backlog for Selected Specialties ------------------------------------------------------- + +rtt_tfc_total_chart_df_select <- rtt_tfc %>% + filter(Treatment_Function_Code %in% c("502", "160", "120", "330", "340", "150")) %>% + group_by(Effective_Snapshot_Date, Treatment_Function_Desc) %>% + summarise(Incomplete_Pathways = sum(Incomplete_Pathways, na.rm = TRUE)) %>% + mutate(Treatment_Function_Desc = case_when(Treatment_Function_Desc == "NULL" ~ "Other", + TRUE ~ Treatment_Function_Desc)) + +rtt_tfc_total_chart_select <- + ggplot(data = rtt_tfc_total_chart_df_select, aes(x = as.Date(Effective_Snapshot_Date), y = Incomplete_Pathways)) + + geom_line(col = "#40C1AC", linewidth = 0.8) + + scale_x_date(breaks = seq(as.Date("2011-04-01"), as.Date("2024-04-01"), by = "3 year"), date_labels = "%b - %y", expand = c(0,0)) + + scale_y_continuous(labels = comma, limits = c(0, NA)) + + geom_vline(xintercept = as.Date("2020-03-01"), linetype = "dashed") + + facet_wrap(~Treatment_Function_Desc, scales = "free") + + labs(x = "Month Ending", + y = "Incomplete Pathways", + caption = "Source: Monthly RTT Published Data", + title = "Total Incomplete Pathways by Treatment Function", + subtitle = "All England - Selected Treatment Functions") + + theme_tu_white_lf(hex_col = "#40C1AC") + +rtt_tfc_total_chart_select + +# TFC Total Backlog for Selected Specialties ------------------------------------------------------- + +rtt_tfc_total_chart_df_select_index_factors <- rtt_tfc_total_chart_df_select %>% + filter(Effective_Snapshot_Date == as.Date("2020-02-29")) %>% + mutate(Index_PC = Incomplete_Pathways) %>% + select(c(2,4)) + +rtt_tfc_total_chart_df_select_index <- rtt_tfc_total_chart_df_select %>% + left_join(rtt_tfc_total_chart_df_select_index_factors, by = "Treatment_Function_Desc") %>% + mutate(Index = Incomplete_Pathways/Index_PC) + +rtt_tfc_total_chart_select_index <- + ggplot(data = rtt_tfc_total_chart_df_select_index, aes(x = as.Date(Effective_Snapshot_Date.x), y = Index)) + + geom_line(col = "#40C1AC", linewidth = 0.8) + + scale_x_date(breaks = seq(as.Date("2011-04-01"), as.Date("2024-04-01"), by = "3 year"), date_labels = "%b - %y", expand = c(0,0)) + + scale_y_continuous(labels = comma, limits = c(0, NA)) + + geom_vline(xintercept = as.Date("2020-03-01"), linetype = "dashed") + + facet_wrap(~Treatment_Function_Desc, scales = "free_x") + + labs(x = "Month Ending", + y = "Relative Index - February 2020", + caption = "Source: Monthly RTT Published Data", + title = "Change in Incomplete Pathways by Treatment Function", + subtitle = "All England - Selected Treatment Functions") + + theme_tu_white_lf(hex_col = "#40C1AC") + +rtt_tfc_total_chart_select_index + +# TFC Backlog Change ------------------------------------------------------ + +max_date <- max(rtt_tfc_total_chart_df$Effective_Snapshot_Date) + +rtt_tfc_total_comp <- rtt_tfc_total_chart_df %>% + filter(Effective_Snapshot_Date == "2020-02-29" | Effective_Snapshot_Date == max_date) %>% + spread(Effective_Snapshot_Date, Incomplete_Pathways) %>% + rename("Pre-COVID" = 2, "Latest" = 3) %>% + mutate(Change = (Latest/`Pre-COVID`) - 1) %>% + arrange(desc(Change)) + +rtt_tfc_total_change_chart <- ggplot(rtt_tfc_total_comp, aes(y = reorder(Treatment_Function_Desc, - Change), x = Change)) + + geom_bar(stat = "identity", fill = "#40C1AC") + + geom_text(aes(label = round(Change * 100, 1)), hjust = 1.1, col = "#000000", size = 3) + + scale_x_continuous(label = percent, breaks = seq(0, 1, by = 0.25)) + + labs(y = "Treatment Function", + x = "Percentage increase (%)", + caption = "Source: Monthly RTT Published Data", + title = "Percentage Change in Incomplete Pathways", + subtitle = "All England - Change since pre-pandemic") + + theme_tu_white_hbar(hex_col = "#40C1AC") + +rtt_tfc_total_change_chart + + +# TFC Waiting Time Summary ------------------------------------------------ + +rtt_total_quantiles_tfc_summary_latest <- rtt_total_quantiles_tfc_summary %>% + filter(Effective_Snapshot_Date == rtt_total_max_date) + +rtt_total_weeks_chart_tfc <- ggplot(rtt_total_quantiles_tfc_summary, aes(x = as.Date(Effective_Snapshot_Date))) + + geom_ribbon(aes(ymin = Percentile_10, ymax = Percentile_90, fill = "10th - 90th Percentile Range"), col = "#ffffff", alpha = 0.5, linewidth = 0.2)+ + geom_ribbon(aes(ymin = Percentile_25, ymax = Percentile_75, fill = "Interquartile Range"), col = "#ffffff", alpha = 0.5, linewidth = 0.2)+ + geom_line(aes(y = Percentile_50, col = "Median Waiting Time"), linewidth = 0.7) + + scale_color_manual("", values = "black") + + scale_fill_manual("", values = c(palette_wong_regions[2], palette_wong_regions[5])) + + scale_x_date(breaks = seq(as.Date("2011-04-01"), as.Date("2024-04-01"), by = "2 year"), date_labels = "%b - %y", expand = c(0,0)) + + scale_y_continuous(expand = c(0,0)) + + geom_hline(yintercept = 18, linetype = "dashed") + + labs(x = "Month Ending", + y = "Weeks Waiting", + caption = "Source: Monthly RTT Published Data", + title = "Summary of Weeks Waiting at Month End", + subtitle = "NHS England Region") + + facet_wrap(~Treatment_Function_Desc, scales = "free_x") + + theme_tu_white_mf(hex_col = palette_tu[1]) + +rtt_total_weeks_chart_tfc + +rtt_total_quantiles_tfc_summary_selected <- rtt_total_quantiles_tfc_summary %>% + filter(Treatment_Function_Desc %in% c("120: Ear Nose and Throat Service", + "140: Oral Surgery Service", + "150: Neurosurgical Service", + "502: Gynaecology Service", + "100: General Surgery Service", + "110: Trauma and Orthopaedic Service")) + +rtt_total_quantiles_tfc_summary_latest_selected <- rtt_total_quantiles_tfc_summary_selected %>% + filter(Effective_Snapshot_Date == rtt_total_max_date) + +rtt_total_weeks_chart_tfc_selected <- ggplot(rtt_total_quantiles_tfc_summary_selected, aes(x = as.Date(Effective_Snapshot_Date))) + + geom_ribbon(aes(ymin = Percentile_10, ymax = Percentile_90, fill = "10th - 90th Percentile Range"), col = "#ffffff", alpha = 0.5, linewidth = 0.2)+ + geom_ribbon(aes(ymin = Percentile_25, ymax = Percentile_75, fill = "Interquartile Range"), col = "#ffffff", alpha = 0.5, linewidth = 0.2)+ + geom_line(aes(y = Percentile_50, col = "Median Waiting Time"), linewidth = 0.7) + + scale_color_manual("", values = "black") + + scale_fill_manual("", values = c(palette_wong_regions[2], palette_wong_regions[5])) + + scale_x_date(breaks = seq(as.Date("2011-04-01"), as.Date("2024-04-01"), by = "2 year"), date_labels = "%b - %y", expand = c(0,0)) + + scale_y_continuous(expand = c(0,0)) + + geom_hline(yintercept = 18, linetype = "dashed") + + labs(x = "Month Ending", + y = "Weeks Waiting", + caption = "Source: Monthly RTT Published Data", + title = "Summary of Weeks Waiting at Month End", + subtitle = "All England - Selected Treatment Functions") + + facet_wrap(~Treatment_Function_Desc, scales = "free_x") + + theme_tu_white_mf(hex_col = palette_tu[1]) + +rtt_total_weeks_chart_tfc_selected + +rtt_total_weeks_latest_tfc_table <- rtt_total_quantiles_tfc_summary_latest_selected %>% + ungroup() %>% + select(c(-2)) %>% + rename("Treatment Function" = 1, + "10th Percentile" = 2, + "Lower Quartile" = 3, + "Median" = 4, + "Upper Quartile" = 5, + "90th Percentile" = 6) %>% + kable(format = "html", align = "lrrrrr") %>% + kable_styling() %>% + row_spec(0, background = palette_tu[1], color = "white") + + +# TFC ScatterPlot --------------------------------------------------------- + +rtt_total_quantiles_tfc_summary_change <- rtt_total_quantiles_tfc_summary %>% + filter(Effective_Snapshot_Date == as.Date(c("2020-02-29")) | Effective_Snapshot_Date == max_date) %>% + select(c(1,2,5)) %>% + spread(Effective_Snapshot_Date, Percentile_50) %>% + rename("Pre" = 2, "Recent" = 3) %>% + mutate("Median_Diff" = Recent - Pre) %>% + inner_join(rtt_tfc_total_comp, by = c("Treatment_Function_Desc")) + + +tfc_scatter_chart <- ggplot(rtt_total_quantiles_tfc_summary_change, aes(x = Median_Diff, y = Change, size = Latest)) + + geom_point(col = palette_tu[1], alpha = 0.7) + + geom_point(col = "#000000", pch = 21, stroke = 1.5) + + geom_text_repel(aes(label = Treatment_Function_Desc), size = 2.3, point.padding = 8) + + scale_y_continuous(labels = percent) + + scale_x_continuous(limits = c(2,12), expand = c(0,0), breaks = seq(2, 12, 2)) + + scale_size_continuous(labels = comma) + + labs(x = "Increase in Median Waiting Time (Days)", + y = "Increase in Total Waiting List Size (%)", + caption = "Source: Monthly RTT Published Data", + title = "Changes in Waiting List Size and Waits", + subtitle = "All England - Treatment Functions") + + selected_theme(hex_col = "#40C1AC") + +tfc_scatter_chart diff --git a/src/visualisation/total_backlog.R b/src/visualisation/total_backlog.R new file mode 100644 index 0000000..e4f1857 --- /dev/null +++ b/src/visualisation/total_backlog.R @@ -0,0 +1,236 @@ + +# Total Incomplete Waiters ------------------------------------------------ + +rtt_total_chart_df <- rtt_total %>% + group_by(Effective_Snapshot_Date) %>% + summarise(Incomplete_Pathways = sum(Incomplete_Pathways, na.rm = TRUE)) + +rtt_total_max_date <- max(rtt_total_chart_df$Effective_Snapshot_Date) + +rtt_total_chart_df_latest <- rtt_total_chart_df %>% + filter(Effective_Snapshot_Date == rtt_total_max_date) + +rtt_total_chart <- + ggplot(data = rtt_total_chart_df, aes(x = as.Date(Effective_Snapshot_Date), y = Incomplete_Pathways)) + + geom_line(col = palette_tu[4], linewidth = 1.2) + + geom_point(data = rtt_total_chart_df_latest, col = palette_tu[4], size = 2) + + geom_label_repel(data = rtt_total_chart_df_latest, aes(label = comma(Incomplete_Pathways)), nudge_x = 600, nudge_y = - 500000) + + scale_x_date(breaks = seq(as.Date("2011-04-01"), as.Date("2024-04-01"), by = "1 year"), date_labels = "%b - %y", expand = c(0,0)) + + scale_y_continuous(labels = comma) + + geom_vline(xintercept = as.Date("2020-03-01"), linetype = "dashed") + + annotate(geom = "label", + x = as.Date("2020-01-01"), + y = 6500000, + label = "Start of pandemic", + hjust = 1) + + labs(x = "Month Ending", + y = "Incomplete Pathways", + caption = "Source: Monthly RTT Published Data", + title = "Total Incomplete Pathways", + subtitle = "All England") + + selected_theme(hex_col = palette_tu[1]) + +rtt_total_chart + +rtt_total_region_chart_df <- rtt_total %>% + filter(!Region_Name %in% c("NULL", "UNKNOWN")) %>% + group_by(Region_Name, Effective_Snapshot_Date) %>% + summarise(Incomplete_Pathways = sum(Incomplete_Pathways, na.rm = TRUE)) + +rtt_total_region_chart_df_latest <- rtt_total_region_chart_df %>% + filter(Effective_Snapshot_Date == rtt_total_max_date) + +rtt_total_region_chart <- + ggplot(data = rtt_total_region_chart_df, aes(x = as.Date(Effective_Snapshot_Date), y = Incomplete_Pathways, col = Region_Name, linetype = Region_Name)) + + geom_line() + + scale_color_manual(values = palette_region, name = "Region") + + scale_linetype_manual(values = c("solid", "dashed", "solid", "dashed", "solid", "dashed", "solid"), name = "Region") + + geom_point(data = rtt_total_region_chart_df_latest, size = 2, show.legend = FALSE) + + geom_text_repel(data = rtt_total_region_chart_df_latest, aes(label = comma(Incomplete_Pathways)), nudge_x = 600, show.legend = FALSE, size = 2.5) + + scale_x_date(breaks = seq(as.Date("2011-04-01"), as.Date("2024-04-01"), by = "1 year"), date_labels = "%b - %y", expand = c(0,0)) + + scale_y_continuous(labels = comma, breaks = c(seq(0, 1500000, by = 250000))) + + geom_vline(xintercept = as.Date("2020-03-01"), linetype = "dashed") + + annotate(geom = "label", + x = as.Date("2020-01-01"), + y = 1200000, + label = "Start of pandemic", + hjust = 1) + + labs(x = "Month Ending", + y = "Incomplete Pathways", + caption = "Source: Monthly RTT Published Data", + title = "Total Incomplete Pathways", + subtitle = "NHS England Regions") + + selected_theme(hex_col = palette_tu[1]) + +rtt_total_region_chart + +# Backlog by Week --------------------------------------------------------- + +rtt_total_quantiles_summary_latest <- rtt_total_quantiles_summary %>% + filter(Effective_Snapshot_Date == rtt_total_max_date) + +rtt_total_weeks_chart <- ggplot(rtt_total_quantiles_summary, aes(x = as.Date(Effective_Snapshot_Date))) + + geom_ribbon(aes(ymin = Percentile_10, ymax = Percentile_90, fill = "10th - 90th Percentile Range"), col = "#ffffff", alpha = 0.5, linewidth = 0.2)+ + geom_ribbon(aes(ymin = Percentile_25, ymax = Percentile_75, fill = "Interquartile Range"), col = "#ffffff", alpha = 0.5, linewidth = 0.2)+ + geom_line(aes(y = Percentile_50, col = "Median Waiting Time"), linewidth = 1.2) + + scale_color_manual("", values = "black") + + scale_fill_manual("", values = c(palette_wong_regions[2], palette_wong_regions[5])) + + geom_point(data = rtt_total_quantiles_summary_latest, aes(y = Percentile_50), size = 2, show.legend = FALSE) + + geom_label_repel(data = rtt_total_quantiles_summary_latest, aes(label = Percentile_50, y = Percentile_50), nudge_x = 200, show.legend = FALSE, col = "black") + + geom_label_repel(data = rtt_total_quantiles_summary_latest, aes(label = Percentile_10, y = Percentile_10), nudge_x = 200, show.legend = FALSE, col = palette_wong_regions[2], nudge_y = -1) + + geom_label_repel(data = rtt_total_quantiles_summary_latest, aes(label = Percentile_25, y = Percentile_25), nudge_x = 200, show.legend = FALSE, col = palette_wong_regions[5], nudge_y = 1) + + geom_label_repel(data = rtt_total_quantiles_summary_latest, aes(label = Percentile_75, y = Percentile_75), nudge_x = 200, show.legend = FALSE, col = palette_wong_regions[5]) + + geom_label_repel(data = rtt_total_quantiles_summary_latest, aes(label = Percentile_90, y = Percentile_90), nudge_x = 200, show.legend = FALSE, col = palette_wong_regions[2]) + + scale_x_date(breaks = seq(as.Date("2011-04-01"), as.Date("2024-04-01"), by = "1 year"), date_labels = "%b - %y", expand = c(0,0)) + + scale_y_continuous(expand = c(0,0)) + + geom_hline(yintercept = 18, linetype = "dashed") + + annotate(geom = "label", + x = as.Date("2012-01-01"), + y = 18, + label = "18 Weeks", + hjust = -1) + + labs(x = "Month Ending", + y = "Weeks Waiting", + caption = "Source: Monthly RTT Published Data", + title = "Summary of Weeks Waiting at Month End", + subtitle = "All England") + + selected_theme(hex_col = palette_tu[1]) + +rtt_total_weeks_chart + +rtt_total_quantiles_region_summary_cleansed <- rtt_total_quantiles_region_summary %>% + filter(!Region_Name %in% c("NULL", "UNKNOWN")) + +rtt_total_quantiles_region_summary_latest <- rtt_total_quantiles_region_summary %>% + filter(Effective_Snapshot_Date == rtt_total_max_date) + +rtt_total_weeks_chart_region <- ggplot(rtt_total_quantiles_region_summary_cleansed, aes(x = as.Date(Effective_Snapshot_Date))) + + geom_ribbon(aes(ymin = Percentile_10, ymax = Percentile_90, fill = "10th - 90th Percentile Range"), col = "#ffffff", alpha = 0.5, linewidth = 0.2)+ + geom_ribbon(aes(ymin = Percentile_25, ymax = Percentile_75, fill = "Interquartile Range"), col = "#ffffff", alpha = 0.5, linewidth = 0.2)+ + geom_line(aes(y = Percentile_50, col = "Median Waiting Time"), linewidth = 0.7) + + scale_color_manual("", values = "black") + + scale_fill_manual("", values = c(palette_wong_regions[2], palette_wong_regions[5])) + + scale_x_date(breaks = seq(as.Date("2011-04-01"), as.Date("2024-04-01"), by = "2 year"), date_labels = "%b - %y", expand = c(0,0)) + + scale_y_continuous(expand = c(0,0)) + + geom_hline(yintercept = 18, linetype = "dashed") + + labs(x = "Month Ending", + y = "Weeks Waiting", + caption = "Source: Monthly RTT Published Data", + title = "Summary of Weeks Waiting at Month End", + subtitle = "NHS England Region") + + facet_wrap(~Region_Name, scales = "free_x", nrow = 2) + + theme_tu_white_mf(hex_col = palette_tu[1]) + +rtt_total_weeks_chart_region + +rtt_total_weeks_latest_table <- rtt_total_quantiles_region_summary_latest %>% + ungroup() %>% + select(c(-2)) %>% + rename("Region" = 1, + "10th Percentile" = 2, + "Lower Quartile" = 3, + "Median" = 4, + "Upper Quartile" = 5, + "90th Percentile" = 6) %>% + kable(format = "html", align = "lrrrrr") %>% + kable_styling() %>% + row_spec(0, background = palette_tu[1], color = "white") + +# Waiting List Shape ------------------------------------------------------ + +rtt_waiting_list_shape_chart <- ggplot(rtt_wls, aes(x = weeks_int, y = Incomplete_Pathways, fill = factor(Effective_Snapshot_Date))) + + geom_area(stat = "identity", position = "identity", col = "white") + + facet_wrap(~(format(Effective_Snapshot_Date, "%B %Y"))) + + scale_fill_manual(values = c(palette_wong_regions[1], palette_wong_regions[5]), name = "Month Ending") + + scale_y_continuous(label = comma, expand = c(0,0)) + + scale_x_continuous(label = comma, expand = c(0,0)) + + geom_vline(xintercept = 18, linetype = "dashed") + + annotate(geom = "text", + x = 20, + y = 0.8 * max(rtt_wls$Incomplete_Pathways), + label = "18 Weeks", + hjust = -0.1) + + labs(x = "Weeks Waiting", + y = "Incomplete Pathways", + caption = "Source: Monthly RTT Published Data", + title = "Shape of RTT Incomplete Waiting List at Month End - Pre-Pandemic and Latest Month", + subtitle = "All England") + + selected_theme(hex_col = palette_tu[1]) + +rtt_waiting_list_shape_chart + +rtt_waiting_list_shape_prop_chart <- ggplot(rtt_wls, aes(x = weeks_int, y = Incomplete_Pathways_Prop, fill = factor(Effective_Snapshot_Date))) + + geom_area(stat = "identity", position = "identity", col = "white") + + facet_wrap(~(format(Effective_Snapshot_Date, "%B %Y"))) + + scale_fill_manual(values = c(palette_wong_regions[1], palette_wong_regions[5]), name = "Month Ending") + + scale_y_continuous(label = percent, expand = c(0,0)) + + scale_x_continuous(label = comma, expand = c(0,0)) + + geom_vline(xintercept = 18, linetype = "dashed") + + annotate(geom = "text", + x = 20, + y = 0.8 * max(rtt_wls$Incomplete_Pathways_Prop), + label = "18 Weeks", + hjust = -0.1) + + labs(x = "Weeks Waiting", + y = "Percentage of Incomplete Pathways", + caption = "Source: Monthly RTT Published Data", + title = "Shape of RTT Incomplete Waiting List at Month End", + subtitle = "All England - Pre-Pandemic and Latest Month") + + selected_theme(hex_col = palette_tu[1]) + +rtt_waiting_list_shape_prop_chart + +rtt_waiting_list_shape_prop_overlap_chart <- ggplot(rtt_wls, aes(x = weeks_int, y = Incomplete_Pathways_Prop, fill = factor(format(Effective_Snapshot_Date, "%B - %Y")))) + + geom_area(stat = "identity", position = "identity", col = "white", alpha = 0.5) + + scale_fill_manual(values = c(palette_wong_regions[1], palette_wong_regions[5]), name = "Month Ending") + + scale_y_continuous(label = percent, expand = c(0,0)) + + scale_x_continuous(label = comma, expand = c(0,0)) + + geom_vline(xintercept = 18, linetype = "dashed") + + annotate(geom = "text", + x = 20, + y = 0.8 * max(rtt_wls$Incomplete_Pathways_Prop), + label = "18 Weeks", + hjust = -0.1) + + labs(x = "Weeks Waiting", + y = "Percentage of Incomplete Pathways", + caption = "Source: Monthly RTT Published Data", + title = "Shape of RTT Incomplete Waiting List at Month End", + subtitle = "All England - Pre-Pandemic and Latest Month") + + selected_theme(hex_col = palette_tu[1]) + +rtt_waiting_list_shape_prop_overlap_chart + + +# Waiting List Shape Animations ------------------------------------------- + +rtt_wls_counts_animation <- ggplot(data = rtt_wls_animate, aes (x = weeks_int, y = Incomplete_Pathways))+ + geom_area(fill = palette_tu[4], alpha = 0.5, col = palette_tu[4]) + + scale_x_continuous(expand = c(0,0)) + + scale_y_continuous(labels = comma, expand = c(0,0)) + + labs(x = "Weeks Waiting", + y = "Incomplete Pathways", + caption = "Source: Monthly RTT Published Data", + title = "Shape of RTT Incomplete Waiting List", + subtitle = "All England - Month Ending: {closest_state}") + + selected_theme(hex_col = palette_tu[1]) + + transition_states(Effective_Snapshot_Date, transition_length = 5, state_length = 15, wrap = TRUE) + + enter_fade() + + exit_fade() + +rtt_wls_counts_animation + +rtt_wls_prop_animation <- ggplot(data = rtt_wls_animate, aes (x = weeks_int, y = Incomplete_Pathways_Prop))+ + geom_area(fill = palette_tu[4], alpha = 0.5, col = palette_tu[4]) + + scale_x_continuous(expand = c(0,0)) + + scale_y_continuous(labels = percent, expand = c(0,0)) + + labs(x = "Weeks Waiting", + y = "Percentage of Total Incomplete Pathways", + caption = "Source: Monthly RTT Published Data", + title = "Shape of RTT Incomplete Waiting List", + subtitle = "All England - Month Ending: {closest_state}") + + selected_theme(hex_col = palette_tu[1]) + + transition_states(Effective_Snapshot_Date, transition_length = 5, state_length = 15, wrap = TRUE) + + enter_fade() + + exit_fade() + +rtt_wls_prop_animation