System Dynamics in health and care

fitting square data into round models

Sally Thompson

09 October 2023

Health Data in the Headlines

newspaper headline waiting list hits record 7.5 million

news headline linking ambulance response times to to A&E waits

news headline links delays in discharging people from hospital to full A&E departments

Through the System Dynamics lens

stock-flow structure of a simple capacity-constrained model

Stock-flow model

Dynamic behaviour, feedback loops

Determining flows

One stock model, with one flow in and one flow out - the flow in, labelled as 'admissions per day', is highlighted.

‘admissions per day’ is needed to populate the model.

‘discharged’ could be used to verify the model against known data

  • How many admissions per day (or week, month…)

list of first 10 key dates, starting on January 1st 2022.

Determining occupancy

One stock model, with one flow in and one flow out - the stock, labelled as 'on ward', is highlighted.

‘on ward’ is used to verify the model against known data

  • Logic statement testing if the key date is wholly between admission and discharge dates
  • flag for a match

List of key dates,

in R - flows

Easy to do with count, or group_by and summarise

  admit_d <- spell_dates |> 
  group_by(date_admit) |>
  count(date_admit)

head(admit_d)
# A tibble: 6 × 2
# Groups:   date_admit [6]
  date_admit     n
  <date>     <int>
1 2022-01-01    28
2 2022-01-02    24
3 2022-01-03    21
4 2022-01-04    27
5 2022-01-05    32
6 2022-01-06    27

in R - occupancy

Generate list of key dates

date_start <- dmy(01012022) 
date_end <- dmy(31012022)
run_len <- length(seq(from = date_start, to = date_end, by = "day"))

keydates <- data.frame(
  date = c(seq(date_start, by = "day", length.out=run_len)))  
        date
1 2022-01-01
2 2022-01-02
3 2022-01-03
4 2022-01-04
5 2022-01-05
6 2022-01-06

in R - occupancy

Iterate over each date - need to have been admitted before, and discharged after

occupancy_flag <- function(df) {

 # pre-allocate tibble size to speed up iteration in loop
  activity_all <- tibble(nrow = nrow(df))  |>  
    select()
 
   for (i in 1:run_len) {
     
      activity_period <-  case_when(
     
      # creates 1 flag if resident for complete day
      df$date_admit < keydates$keydate[i] & 
        df$date_discharge > keydates$keydate[i] ~ 1,
      TRUE ~ 0)
   
      # column bind this day's flags to previous
      activity_all <- bind_cols(activity_all, activity_period)
 
   }
  
    # rename column to match the day being counted
  activity_all <- activity_all |> 
    setNames(paste0("d_", keydates$date))
    
  # bind flags columns to patient data
  daily_adm <- bind_cols(df, activity_all) |> 
    pivot_longer(
      cols = starts_with("d_"),
      names_to = "date",
      values_to = "count"
    ) |> 
    
    group_by(date) |> 
    summarise(resident = sum(count)) |> 
    ungroup() |> 
  mutate(date = str_remove(date, "d_"))
   
 }

Is there a better way than using a for loop?

Longer Time Periods - flows

Use lubridate::floor_date to generate the date at start of week/month

admit_wk <- spell_dates |> 
  mutate(week_start = floor_date(
    date_admit, unit = "week", week_start = 1   # start week on Monday
  )) |> 
  count(week_start)     # could add other parameters such as provider code, TFC etc

head(admit_wk)
# A tibble: 6 × 2
  week_start     n
  <date>     <int>
1 2021-12-27    52
2 2022-01-03   196
3 2022-01-10   192
4 2022-01-17   223
5 2022-01-24   157
6 2022-01-31   187

Longer Time Periods - occupancy

Key dates to include the dates at the start and end of each time period

date_start <- dmy(03012022) # first Monday of the year
date_end <- dmy(01012023)
run_len <- length(seq(from = date_start, to = date_end, by = "week"))

keydates <- data.frame(wk_start = c(seq(date_start, 
                                        by = "week", 
                                        length.out=run_len))) |>  
  mutate(
    wk_end = wk_start + 6)    # last date in time period
    wk_start     wk_end
1 2022-01-03 2022-01-09
2 2022-01-10 2022-01-16
3 2022-01-17 2022-01-23
4 2022-01-24 2022-01-30
5 2022-01-31 2022-02-06
6 2022-02-07 2022-02-13

Longer Time Periods

More logic required if working in weeks or months - can only be in one place at any given time

# flag for occupancy
activity_period <-  case_when(
  
        # creates 1 flag if resident for complete week
      df$date_admit < keydates$wk_start[i] & df$date_discharge > keydates$wk_end[i] ~ 1,
        TRUE ~ 0)

Applying the data

One stock model, with one flow in and one flow out - the stock has a time chart overlaid showing model output compared to 'real' data

Next Steps

  • Generalise function to a state where it can be used by others - onto Github

  • Turn this into a package

  • Open-source SD models and interfaces - R Shiny or Python

Questions, comments, suggestions?




Please get in touch!

Sally.Thompson37@nhs.net

NHS-R conference 2023