Author: Kenneth Nieser

# Profiling hospitals based on psychiatric readmission rates

#### Kenneth Nieser

This vignette includes an example of hospital profiling based on a measure of thirty-day all-cause unplanned readmission following psychiatric hospitalization in an inpatient psychiatric facility (IPF Readmission). This claims-based measure is reported by hospitals to CMS as part of the Inpatient Psychiatric Facility Quality Reporting Program.

    library(QualityMeasure)

First, we’ll load the dataset included with the `QualityMeasure` package.

    df <- psychreadmission
    knitr::kable(head(df), 'simple')

| entity | category | n | rate | rate.lwr | rate.upr
--- | --- | --- | --- | --- | --- | ---
1 | 10011 | No Different Than the National Rate | 138 | 23.7 | 18.5 | 30.0
2 | 10012 | No Different Than the National Rate | 145 | 16.0 | 11.8 | 21.2
3 | 10016 | No Different Than the National Rate | 85 | 21.0 | 15.8 | 27.2
5 | 10023 | No Different Than the National Rate | 104 | 20.5 | 15.9 | 26.1
6 | 10033 | No Different Than the National Rate | 207 | 21.5 | 17.6 | 26.1
7 | 10034 | No Different Than the National Rate | 49 | 20.9 | 14.5 | 29.0

Next, we will plot the risk-standardized readmission rates (RSRR) with corresponding confidence intervals and a dashed, red line to indicate the national average rate.

    marg.p = sum(df$n * df$rate) / (sum(df$n)) / 100

    df$rank = rank(df$rate, ties.method = 'random')

    profile.fig <- ggplot(data = df, aes(x = rank, y = rate)) +
      geom_point(color = 'black') +
      geom_errorbar(aes(ymin = rate.lwr, ymax = rate.upr), width = 0.1) +
      geom_hline(yintercept = marg.p * 100, col = 'red', lty = 'dashed', linewidth = 1.2, alpha = 0.7) +
      xlab('Hospital Rank') +
      ylab('Readmission Rate (%)') +
      theme_classic() +
      theme(
        axis.text = element_text(size = 16),
        axis.ticks.length = unit(.25, 'cm'),
        axis.title = element_text(size = 18, face = 'bold')
      )
    profile.fig

We can also examine the number of hospitals with rates that are below average, above average, and no different from average.

    knitr::kable(table(df$category), 'simple', col.names = c('Category', 'Count'))

Category | Count
--- | ---
Better Than the National Rate | 43
No Different Than the National Rate | 1091
Worse Than the National Rate | 90