R Shiny Apps: Exploring Medicare Spending Across Providers (R Codes)

In this blog I developed an R shiny apps that explores the differences on average medicare spending across providers by period and claim type within each state. You can read the data description and explore the apps here.

The R codes used to develop the interactive R-shiny apps is provided in two separate components: (1) user-interface script (ui.r) that controls the layout and appearance of the apps, and (2) server script (server.r) that contains R program instructions, such as calling the data, loading the package and creating the interactive apps. The files along with the data used for this app can also be downloaded from my github page.

ui.r code

In [ ]:


fluidPage(
  h3("Exploring Average Medicare Hospital Spending by Period and Claim Type"),
  h4("Data Description"),
  p("Medical spending per beneficiary data and data description was obtained from", a("Data.Medicare.gov", href="https://data.medicare.gov/"),". The data displayed here shows average spending levels during hospitals’ Medicare Spending per Beneficiary (MSPB) episodes. An MSPB episode includes all Medicare Part A and Part B claims paid during the period from 3 days prior to a hospital admission through 30 days after discharge. These average Medicare payment amounts have been price-standardized to remove the effect of geographic payment differences and add-on payments for indirect medical education (IME) and disproportionate share hospitals (DSH)."),
  h4("Purpose of the Apps"),
  p("The aim of this shiny apps is to explore the differences on average spending across providers by period and claim type within states. The average spending was compared across states in", a("another blog", href="http://datascienceandme.com/topics/medicareAcrossStates.html")),
  p("The following scatter plot helps to visualize Medicare average spending per episode among different providers. You can explore average spending within each state for a given period and type of claim by selecting the state from the drop-down box, and period and claim type from the radio buttons. Summary statistics of average spending for a given selection is provided on the top of the application, followed by scatter plot of average spending. Provider with highest average spending are listed under the scatter plot. You can see the name of provider and the average spending by hovering the cursor on each observation. In summary the top ten highest average spending was for inpatient claims during index hospital admission in the state of Texas (3 providers), Ohio, Nebraska, Indiana, Kansas (each 1 provider) and Oklahoma (2 provider)."),
p("Note that if a given period and type of claim for a given state have no data, no observation appears on the scatter plot. "),
  fluidRow(
    column(3,
      wellPanel(
        selectInput("state", "USA States:", c("AK","AL", "AR", "AZ", "CA", "CO", "CT", "DC", "DE", "FL", "GA", "HI", "IA", "ID", "IL", "IN", "KS", "KY", "LA", "MA", "ME", "MI", "MN", "MO", "MS", "MT", "NC", "ND", "NE", "NH", "NJ", "NM", "NV", "NY", "OH", "OK", "OR", "PA", "RI", "SC", "SD", "TN", "TX", "UT", "VA", "VT", "WA", "WI", "WV", "WY")),
        radioButtons("period", "Period: ", c("During Index Hospital Admission", "30 days After Discharge from Index Hospital Admission", "1 to 3 days Prior to Index Hospital Admission")),
        radioButtons("clmType", "Claim Type: ", c("Inpatient", "Skilled Nursing Facility", "Durable Medical Equipment Carrier", "Home Health Agency", "Hospice", "Outpatient"))
      )
    ),
    column(9,
      verbatimTextOutput("smryTable"),
      ggvisOutput("sctrPlot"),
      wellPanel(
        span(h4("Total number of Providers:"),  textOutput("nmbrProviders") ),
        span(h4("Top 10 Providers with highest average spending in decreasing order:"),  textOutput("topProviders") )
        )
    )
  )
)

server.r code

In [ ]:
library(shiny)
library(ggvis)
library(dplyr)
library(stargazer)


# Import Medicare spending *.CSV dataset
mdClm <- read.csv(paste("./data/Medicare Hospital Spending by Claim.csv", sep=""))
mdClm <- arrange(mdClm, State, Hospital_Name)
mdClm$ID <- seq(1,length(mdClm$Hospital_Name),1)
mdClm$prvdrSpndng <-  paste(paste0(mdClm$Hospital_Name,": "), paste0("$", format(mdClm$Avg_Spending_Per_Episode_Hospital, big.mark = ",", scientific = FALSE),";"))
mdClm <-  mdClm %>%
            filter(Period != "Complete Episode" & Claim_Type != "Total")
mdClm <- rename(mdClm, AvgSpndngHsptl=Avg_Spending_Per_Episode_Hospital, AvgSpndngState=Avg_Spending_Per_Episode_State, AvgSpndngNtn=Avg_Spending_Per_Episode_Nation) 


function(input, output, session) {

  mdClmFnl <- reactive({
    # Apply filters
        mdClm %>%
        filter(State == input$state, Period == input$period, Claim_Type == input$clmType) 
  })

  
  
  # Function for generating tooltip text
  mdclm_tooltip <- function(x) {
    if (is.null(x)) return(NULL)
    if (is.null(x$ID)) return(NULL)

    # Pick out the average spending with this ID
    all_mdClmFnl <- isolate(mdClmFnl())
    mdClms <- all_mdClmFnl[all_mdClmFnl$ID == x$ID, ]

    paste0("<b>", "State: ", mdClms$State, "</b><br>",
            "Provider Name: ", mdClms$Hospital_Name, "<br>",
            "Spending: ", "$", format(mdClms$AvgSpndngHsptl, big.mark = ",", scientific = FALSE)
    )
  }

  # A reactive expression with the ggvis plot
  vis <- reactive({
        mdClmFnl() %>%
        ggvis(x = ~ID , y = ~AvgSpndngHsptl) %>%
        layer_points(size := 100, size.hover := 300, 
            fillOpacity := 0.1, fillOpacity.hover := 0.5, stroke.hover := "red", fill.hover :="red",
                stroke = ~AvgSpndngHsptl, key := ~ID) %>%
        add_tooltip(mdclm_tooltip, on = c("hover")) %>%
        add_axis("x", title = "Provider", properties = axis_props(title = list(fontSize = 16))) %>%
        add_axis("y", title = "Medicare Hospital Spending by Claim", title_offset=50,
                properties = axis_props(title = list(fontSize = 16))) %>%
        add_legend("stroke", title = "Average Spending") %>%
        set_options(width = 1000, height = 500)
    })

  vis %>% bind_shiny("sctrPlot")

  output$nmbrProviders <- renderText({ length(unique(mdClmFnl()$Hospital_Name)) })

  # Summary statistics 
  output$smryTable <- renderPrint({
    AvgSpndngpEH <- data.frame(AvgSpndngpEH=mdClmFnl()$AvgSpndngHsptl)
    if(nrow(AvgSpndngpEH) > 0){
        stargazer(AvgSpndngpEH , type = "text", title="Summary of Medicare Average Spending per Episode Hospital", digits=0, median=TRUE, iqr=TRUE, min.max=TRUE)
    } else {
    print(paste("No Observation"))
    }
  })
  

  mdClmFnl <- reactive({
    # Apply filters
    mdClm %>%
    filter(State == input$state, Period == input$period, Claim_Type == input$clmType) 
  })
  
  
  
  OrdrdBySpndng <- reactive({
    # Apply filters
    mdClm %>%
    arrange(desc(AvgSpndngHsptl)) %>%
    filter(State == input$state, Period == input$period, Claim_Type == input$clmType)  
    })

    output$topProviders <- renderText({head(OrdrdBySpndng()$prvdrSpndng, n=10) })
}
In [ ]: