In HorridTom/hospitalflow: Analysis of Patient Flow in Hospitals

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  echo = FALSE,
  warning = FALSE,
  message = FALSE
)

library(magrittr)

sample_duration <- lubridate::duration(params$sample_weeks, "weeks")
sample_no_of_patients <- params$sample_no_of_patients

Package version: r stringr::str_sub(system("git rev-parse HEAD", intern=TRUE), 1, 8)

Number of weeks used as sample: r params$sample_weeks

Number of patients sampled: r params$sample_no_of_patients

if (!params$use_existing_spell_table) {
  # Import and Standardise Data

  if (!params$use_example_data) {
    import_list <- readRDS(params$import_list_path)

    # This import list uses relative paths (good for us during development)
    # which means the paths need prepending with "../" to work from the
    # working directory used in running this file.
    # In production use, users will be best specifying their import paths
    # as absolute paths.
    import_list <- lapply(import_list, function(x) {
      list(
        data_path = paste0("../", x$data_path),
        config_path = paste0("../", x$config_path),
        site = x$site,
        facility = x$facility,
        time_zone = x$time_zone
      )
    })
  } else {
    import_list <- list(
      ed_import = list(
        data_path = system.file("extdata", "example_hospital_ed_data.csv", package = "hospitalflow"),
        config_path = system.file("extdata", "example-config", "ed", package = "hospitalflow"),
        site = "Site 1",
        facility = "ED",
        time_zone = "Europe/London"
      ),
      ip_import = list(
        data_path = system.file("extdata", "example_hospital_inpatient_data.csv", package = "hospitalflow"),
        config_path = system.file("extdata", "example-config", "inpatient", package = "hospitalflow"),
        site = "Site 1",
        facility = "IP",
        time_zone = "Europe/London"
      )
    )
  }

  data_list <- import_standardise_bind(import_list)
}

if (!params$use_existing_spell_table) {
  ed_data <- data_list[["ED"]]
  inpatient_data <- data_list[["IP"]]

  data_start_date <- as.Date(max(
    min(ed_data$start_datetime, na.rm = TRUE),
    min(ed_data$end_datetime, na.rm = TRUE),
    min(inpatient_data$start_datetime, na.rm = TRUE),
    min(inpatient_data$end_datetime, na.rm = TRUE)
  ))
  data_end_date <- as.Date(min(
    max(ed_data$start_datetime, na.rm = TRUE),
    max(ed_data$end_datetime, na.rm = TRUE),
    max(inpatient_data$start_datetime, na.rm = TRUE),
    max(inpatient_data$end_datetime, na.rm = TRUE)
  ))
  start_date <- data_start_date
  end_date <- data_end_date

  # samples down by time frame
  if (!is.null(params$sample_weeks)) {
    data_start_date <- lubridate::ceiling_date(data_start_date, "month")
    data_end_date <- lubridate::floor_date(data_end_date, "month")

    if (data_end_date - data_start_date > sample_duration) {
      start_date <- data_end_date - sample_duration
      end_date <- data_end_date
      example_ed_data <- ed_data %>% dplyr::filter(
        start_datetime <= end_date,
        end_datetime >= start_date
      )
      example_inpatient_data <- inpatient_data %>% dplyr::filter(
        start_datetime <= end_date,
        end_datetime >= start_date
      )
    } else {
      example_ed_data <- ed_data
      example_inpatient_data <- inpatient_data
    }
  } else {
    example_ed_data <- ed_data
    example_inpatient_data <- inpatient_data
  }

  # samples down by number of patients
  if (!is.null(sample_no_of_patients)) {
    inpatients <- levels(factor(example_inpatient_data$pseudo_id))
    sample_inpatients <- sample(inpatients, sample_no_of_patients)

    example_ed_data <- example_ed_data %>%
      dplyr::filter(pseudo_id %in% sample_inpatients)

    example_inpatient_data <- example_inpatient_data %>%
      dplyr::filter(pseudo_id %in% sample_inpatients)
  }

  example_spell_list <- make_spell_table(
    ed_data = example_ed_data,
    inpatient_data = example_inpatient_data
  )
  example_spell_table <- example_spell_list$spell_table
  example_all_episodes <- example_spell_list$all_episodes

  example_spell_table <- add_spell_variables(
    ed_data = example_ed_data,
    inpatient_data = example_inpatient_data,
    spell_table = example_spell_table
  )
  example_moves_table <- make_moves_table(
    ed_data = example_ed_data,
    inpatient_data = example_inpatient_data,
    all_episodes = example_all_episodes,
    ward_mapping_config_path = import_list$ip_import$config_path
  )
} else {
  # pointing to existing spell table

  if (params$use_example_data) {
    example_spell_table <- spell_table
    example_moves_table <- moves_table
  } else {
    example_spell_table <- readRDS(params$existing_spell_table_path)
    example_moves_table <- readRDS(params$existing_moves_table_path)
  }

  data_start_date <- as.Date(max(
    min(example_spell_table$spell_start, na.rm = TRUE),
    min(example_spell_table$spell_end, na.rm = TRUE),
    min(example_moves_table$move_datetime, na.rm = TRUE)
  ))

  data_end_date <- as.Date(min(
    max(example_spell_table$spell_start, na.rm = TRUE),
    max(example_spell_table$spell_end, na.rm = TRUE),
    max(example_moves_table$move_datetime, na.rm = TRUE)
  ))

  start_date <- data_start_date
  end_date <- data_end_date

  # samples down by time frame
  if (!is.null(params$sample_weeks)) {
    data_start_date <- lubridate::ceiling_date(data_start_date, "month")
    data_end_date <- lubridate::floor_date(data_end_date, "month")

    if (data_end_date - data_start_date > sample_duration) {
      start_date <- data_end_date - sample_duration
      end_date <- data_end_date
      example_spell_table <- example_spell_table %>%
        dplyr::filter(
          spell_start <= end_date,
          spell_end >= start_date
        )
      example_moves_table <- example_moves_table %>%
        dplyr::filter(
          move_datetime <= end_date,
          move_datetime >= start_date
        )
    }
  }

  # samples down by number of patients
  if (!is.null(sample_no_of_patients)) {
    patients <- levels(factor(example_spell_table$pseudo_id))
    sample_patients <- sample(patients, sample_no_of_patients)

    example_spell_table <- example_spell_table %>%
      dplyr::filter(pseudo_id %in% sample_patients)

    example_moves_table <- example_moves_table %>%
      dplyr::filter(pseudo_id %in% sample_patients)
  }
}

Age and Gender

plot_ed_attendance_demographics(
  data = example_spell_table,
  startDate = start_date,
  endDate = end_date,
  returnPlot = TRUE,
  hospitalName = "Anytown General Hospital")

Arrival Occupancy

plot_ed_arrival_occupancy_hour_of_day(
  startDate = as.POSIXct(start_date, tz = "Europe/London"),
  endDate = as.POSIXct(end_date, tz = "Europe/London"),
  data = example_spell_table,
  returnPlot = TRUE,
  hospitalName = "Anytown General Hospital"
)

Four hour performance by flow group

plot_ed_4hourperf_timeseries_flow(
  data = example_spell_table,
  startDate = as.Date(start_date),
  endDate = as.Date(end_date),
  timeUnit = "day",
  returnPlot = TRUE,
  hospitalName = "Anytown General Hospital")

Duration in ED by flow group

plot_ed_los_distribution_flow(
  data = example_spell_table,
  startDate = start_date,
  endDate = end_date,
  returnPlot = TRUE,
  hospitalName = "Anytown General Hospital")

Duration in ED by admitted/non-admitted

plot_ed_los_distribution_admission(
  data = example_spell_table,
  startDate = start_date,
  endDate = end_date,
  returnPlot = TRUE,
  hospitalName = "Anytown General Hospital")

Duration in ED by flow group

plot_average_ed_los_hour_of_day(
  data = example_spell_table,
  startDate = start_date,
  endDate = end_date,
  returnPlot = TRUE,
  hospitalName = "Anytown General Hospital"
)

Admissions and Discharges by Day of Week

plot_admissions_discharges_day_of_week(
  startDate = start_date, endDate = end_date,
  data = example_spell_table,
  returnPlot = TRUE,
  hospitalName = "Anytown General Hospital"
)

Length of Stay

plot_los_distribution_admission_method(
  data = example_spell_table,
  startDate = start_date,
  endDate = end_date,
  returnPlot = TRUE,
  hospitalName = "Anytown General Hospital")

ED occupancy by hour of week

plot_ed_occupancy_hour_of_week(
  data = example_spell_table,
  startDate = as.POSIXct(start_date, tz = "Europe/London"),
  endDate = as.POSIXct(end_date, tz = "Europe/London"),
  returnPlot = TRUE,
  hospitalName = "Anytown General Hospital")

Monthly 7-day Readmission Rate

plot_readmissions_timeseries(
  data = example_spell_table,  
  startDate = as.POSIXct(start_date, tz = "Europe/London"),
  endDate = as.POSIXct(end_date, tz = "Europe/London"),
  returnPlot = TRUE,
  hospitalName = "Anytown General Hospital",
  readmissionBy = 7)

Monthly 30-day Readmission Rate

plot_readmissions_timeseries(
  data = example_spell_table,  
  startDate = as.POSIXct(start_date, tz = "Europe/London"),
  endDate = as.POSIXct(end_date, tz = "Europe/London"),
  returnPlot = TRUE,
  hospitalName = "Anytown General Hospital",
  readmissionBy = 30)

Monthly 90-day Readmission Rate

plot_readmissions_timeseries(
  data = example_spell_table,  
  startDate = as.POSIXct(start_date, tz = "Europe/London"),
  endDate = as.POSIXct(end_date, tz = "Europe/London"),
  returnPlot = TRUE,
  hospitalName = "Anytown General Hospital",
  readmissionBy = 90)

Sankey Flow Diagram High Level

plot_flow_diagram(
  moves_table = example_moves_table,
  ward_level = F,
  start = NULL,
  end = NULL,
  selected_levels = NULL,
  remove_static_moves = F
)

Sankey Flow Diagram Ward Level

plot_flow_diagram(
  moves_table = example_moves_table,
  ward_level = T,
  start = NULL,
  end = NULL,
  selected_levels = NULL,
  remove_static_moves = F
)

HorridTom/hospitalflow documentation built on June 14, 2022, noon