Author: Kenneth Nieser

# Colonoscopy follow-up measure example

#### Kenneth Nieser

This vignette includes an example of hospital profiling based on a measure of whether patients receive appropriate recommendations for a follow-up colonoscopy.

    library(QualityMeasure)
    #> Loading required package: ggplot2
    #> Loading required package: doParallel
    #> Loading required package: foreach
    #> Loading required package: iterators
    #> Loading required package: parallel
    #> Loading required package: lme4
    #> Loading required package: Matrix
    #> Package 'QualityMeasure' version 2.0.1
    #>
    #> If you have issues or feedback, please email me at nieser@stanford.edu, so I can make this package better!
    #>
    #> For more info about this package, see https://github.com/knieser/quality_measure_reliability.

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

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

entity | p | n | x
--- | --- | --- | ---
010001 | 0.72 | 29 | 21
010005 | 1.00 | 210 | 210
010006 | 0.86 | 85 | 73
010007 | 0.65 | 52 | 34
010008 | 0.67 | 12 | 8
010011 | 0.83 | 42 | 35

Next, we will calculate reliability using the Beta-Binomial method for aggregated data.

    BB.results <- calcBetaBin(df = df, df.aggregate = T, n = 'n', x = 'x')
    #>  Currently, Beta-Binomial reliability estimates do not account for risk-adjustment (even if you specified a model). Updates to this function to account for risk-adjustment are in progress.
    #> Note that aggregated data are being used, so Beta-Binomial reliability estimates with random effects predictions cannot be calculated.

Beta-Binomial parameter estimates are: alpha = 4.516 and beta = 0.43. The between-entity variance in rates is 0.013.

Below is a summary of the distribution of entity-level reliability estimates.

    summary(BB.results$est.BB)
    #>    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.
    #>  0.6898  0.9010  0.9381  0.9171  0.9546  0.9975

We can also plot entity-level reliability results by sample size.

    plot.df <- data.frame(
      n = df$n,
      rel = BB.results$est.BB
    )

    fig <- ggplot(data = plot.df, aes(x = n, y = rel)) +
      geom_point(size = 3) +
      geom_hline(yintercept = median(BB.results$est.BB), linetype = 'dashed', col = 'red', linewidth = 2) +
      annotate('text', x = 1700, y = 0.92, label = 'Median reliability', size = 6, col = 'red') +
      xlab('Entity sample size') +
      ylab('Reliability') +
      theme_classic() +
      theme(
        panel.grid.major = element_line(),
        panel.grid.minor = element_line(),
        axis.text = element_text(size = 16),
        axis.ticks.length = unit(.25, 'cm'),
        axis.title = element_text(size = 18, face = 'bold')
      )
    fig