US Healthcare Spending Variation within Medicare
Contributed by Brain Saindon. He took NYC Data Science Academy 12 week full time Data Science Bootcamp program between Sept 23 to Dec 18, 2015. The post was based on his second class project(due at 4th week of the program).
CMS Shiny App
Motivation
According to the World Bank, the US Healthcare System is in on track to reach nearly $10,000 per capita spend on Health Care. The Center for Medicaid and Medicare Services (CMS) released hospital cost and utilization metrics on Medicaid beneficiaries in order to increase transparency and reduce cost within the US health care system. This Shiny App augments the transparency on healthcare expenditure by facilitating exploration on the state level inpatient Medicare provider and utilization data in order to generate rapid descriptive statistics on the variation of average costs among 100 different disease related groups across the US.
Insight on Health Cost Variation
This app invites you to identify simple descriptive statistics of the cost and utilization of Medicare Severity Diagnosis Related Groups (DRG) among Medicare beneficiaries. Compare average cost measures of two or more DRGs or identify geographic differences of average costs for any DRG. You may find similar insights to those I discovered:
- Average Medicare payments for a given DRG vary widely across the US: For example, the average Medicare payments for Acute Myocardial Infarction, Discharged Alive w/ MCC in Alabama is $9,000 for 1,196 discharges compared to over $17,000 for 59 discharges in Alaska.
- Average Covered Charges have an even larger variation across US states: For example, the average covered charges for Acute Myocardial Infarction, Discharged Alive w MCC within Maryland is $17,000 whereas the average covered charges for this same DRG in Nevada is $90,000.
- Intuitively, Average Medicare Payments tend to increase as disease complication increases: Across the US, the average Medicare payments for Acute Myocardial Infarction, Discharged Alive without complicating conditions or major complicating conditions is $4,000 compared to $11,000 with the addition of major complicating conditions.
Insights Summary
Ultimately, I hope this app will increase your curiosity about US healthcare spending. As seen in this dataset released by CMS, there is an enormous amount of variation within Medicaid spending on healthcare. For example, in 2014, average total inpatient Medicare payments for Diabetes w MCC costed Arkansas $8,430 whereas as this same DRG costed Alaska a $19,906! You can see the variation in average total impatient Medicare payments across the US in the map below:
Average Total Inpatient Medicare Payments for Diabetes w MCC
Darker Green indicates higher average inpatient medicare payments.
What can attribute to this drastic variation in cost? What additional procedures for Diabetes w MCC in Alaska account for this difference of about $10,000?
Furthermore, we see that an addition of major complicating conditions can translate into nearly three times the Medicare cost. Check out the difference in average covered charges between Acute Myocardial Infarction W CC compared to Acute Myocardial Infarction W MCC:
Average Medicare Payments: Acute Myocardial Infarction W/O CC/MCC & Acute Myocardial Infarction W/ MCC
Could reducing major complicating conditions lead to a such significant reduction in healthcare spending? If so, how much? Can targeted intervention to prevent such complications result in better health outcomes and more efficient Medicare spending?
This app merely scratches the surface on the potential insights to be derived from the cost and utilization datasets released by CMS. CMS also released outpatient services, physicians and other supplier procedure and services, and all Part D prescriptions.
R Code Available on Github:
https://github.com/bzsaindon/nycdsablog
Detailed R Code:
RDS Creation
ip <-read.csv("data/Medicare_Charge_Inpatient_DRG100_DRG_Summary_by_DRGState_FY2013.csv", sep=",", fill=TRUE, header=TRUE) saveRDS(ip, file="data/ip.RDS")
User Interface
Initially, I load necessary packages and create a list of unique DRG values which will be feed into the choices section for several widgets within the UI.
require(datasets) library(dplyr) library(maps) library(ggplot2) library(shiny) library(ggvis) library(ggthemes) ip <-readRDS("data/ip.RDS") lst.drgs <- as.character(unique(ip$DRG.Definition)) lst.regions<-as.character(unique(state.abb))
For the first part of the UI, I create a sidebarLayout which contains a sidebarPanel of four condiditionalPanels:
shinyUI( fluidPage(theme="bootstrap.min.css", titlePanel("Medicare Provider and Utilization Payment Data: Inpatient"), # main title sidebarLayout( sidebarPanel( conditionalPanel(condition="input.conditionedPanels == 'Single Value Analysis'", selectInput("var", label = h4("Choose Cost Measure:"), choices = c("average_covered_charges_ip", "average_total_payments_ip", "average_medicare_payments_ip", "total_discharges_ip")), selectInput("drgvar", label = h4("Choose DRG:"), choices = lst.drgs)), conditionalPanel(condition="input.conditionedPanels =='Disease Comparisons'", selectizeInput( 'drgcompare', 'Select Diseases to Compare', choices = lst.drgs, multiple = TRUE, select ="039 - EXTRACRANIAL PROCEDURES W/O CC/MCC" )), conditionalPanel(condition="input.conditionedPanels == 'Payment Comparison'", selectizeInput( 'state', 'Select States to Compare', choices = lst.regions, multiple = TRUE, select = "NY" )), conditionalPanel(condition="input.conditionedPanels == 'Map'", selectInput("var", label = h4("Choose Cost Measure:"), choices = c("average_covered_charges_ip", "average_total_payments_ip", "average_medicare_payments_ip", "total_discharges_ip")), selectInput("drgvar", label = h4("Choose DRG:"), choices = lst.drgs)) ),
The second piece of the UI contains a tabset Panel with four TabPanels as part of it.
mainPanel( tabsetPanel(navbarPage("CMS Payment Data", tabPanel("Single Value Analysis", tabPanel("Histogram", plotOutput("histogram")), uiOutput('matrix') ), tabPanel("Disease Comparisons", #plotOutput("histogramcompare"), tabPanel("Average Cost", plotOutput("histogramavgcov")), uiOutput('matrix1'), tabPanel("Average Total Payment", plotOutput("histogramavgtot")), uiOutput('matrix2'), tabPanel("Average Medicare Payments", plotOutput("histogramavgmed")), uiOutput('matrix3'), tabPanel("Total Discharges", plotOutput("histogramtotdis")), uiOutput('matrix4'), tabPanel("Total Discharges Descriptives", tableOutput("summarytable"))), tabPanel("Payment Comparison", plotOutput("scatterplot"), tabPanel("Total Payments v Total Discharges", plotOutput("scatterplot2"))), tabPanel("Map", htmlOutput("map2") ), id = "conditionedPanels" ) ) ) ) ))
Server
Now, let's take a look at the server code. Initially, I create four temporary files using the original ip.RDS dataframe.
ip_tmp <-readRDS("data/ip.RDS") ip <- rename(ip_tmp, region=Provider.State) average_covered_charges_ip <- select(ip, Average.Covered.Charges, region, DRG.Definition) %>% rename(., value = Average.Covered.Charges) average_total_payments_ip <- select(ip, Average.Total.Payments, region, DRG.Definition) %>% rename(., value = Average.Total.Payments) average_medicare_payments_ip <- select(ip, Average.Medicare.Payments, region, DRG.Definition) %>% rename(., value = Average.Medicare.Payments) total_discharges_ip <- select(ip, Total.Discharges, region, DRG.Definition) %>% rename(., value = Total.Discharges)
Next, we will look code relevant to a few output selections within the Shiny Server. I did not include all output objects created in order to maintain brevity in this blog. Keep in mind that all output objects in the server are created within the following function:
shinyServer(function(input, output) { ... })
The first section of the Shiny server outputs a geographic map using the input variable from the UI to indicate cost measure. The ggvis package is essential for this part. The key input variable here is input$var (the cost measure selected by the user).
output$map2 <- renderGvis({ datasetInput2 <- reactive({ switch(input$var, "average_covered_charges_ip" = average_covered_charges_ip, "average_total_payments_ip" = average_total_payments_ip, "average_medicare_payments_ip" = average_medicare_payments_ip, "total_discharges_ip" = total_discharges_ip) }) mapdata2<-filter(datasetInput2(), DRG.Definition==input$drgvar) gvisGeoChart(mapdata2, "region", "value", options=list(title= "US Cost Variation", region="US", displayMode="regions", resolution="provinces", width=600, height=400)) })
Next, the server creates an output histogram using the same input variable as used to create the output map. The output histogram in this section will include the distribution of one cost measure selected by the user as the input$var (average covered charges, average total payments, etc...).
output$histogram<- renderPlot({ datasetInput3 <- reactive({ switch(input$var, "average_covered_charges_ip" = average_covered_charges_ip, "average_total_payments_ip" = average_total_payments_ip, "average_medicare_payments_ip" = average_medicare_payments_ip, "total_discharges_ip" = total_discharges_ip) }) histdata<-filter(datasetInput3(), DRG.Definition==input$drgvar) ggplot(histdata, aes(x=value, fill=DRG.Definition)) + geom_density(aes(x=value, fill=DRG.Definition), alpha=.3) + theme_few() + theme(legend.position="bottom", legend.justification=c(0,1))+ ylab("Density") + xlab(input$var)+ ggtitle(bquote(atop(.("Single Value Analysis"), atop(italic(.(input$drgvar)), ""))))+ theme(legend.title=element_text(size=10)) + guides(shape=guide_legend(override.aes=list(size=100))) })
To add detailed output to this Shiny App, I created a summary matrix to provide simple statistics to several of the images output in this app. Below is the code as part of the server to create this output matrix. This is one example of several matrices that I created within the Shiny Server. Key input variables for this section are input$var (cost measure) and input$drgvar (this is the Diagnosis Related Group selected by the user).
output$matrix<- renderGvis({ datasetInput30 <- reactive({ switch(input$var, "average_covered_charges_ip" = average_covered_charges_ip, "average_total_payments_ip" = average_total_payments_ip, "average_medicare_payments_ip" = average_medicare_payments_ip, "total_discharges_ip" = total_discharges_ip) }) statsdata<-filter(datasetInput30(), DRG.Definition==input$drgvar) stats <- do.call(rbind, lapply((describeBy(statsdata$value, group=statsdata$DRG.Definition, skew=FALSE, range=FALSE)), as.data.frame)) stats$vars <- rownames(stats) stats <- rename(stats, Disease_Condition=vars, Standard_Deviation = sd, Count = n, Mean = mean, Standard_Error = se) gvisTable(stats); })
Another part of the server outputs a 'histogramcompare' object. This piece allows the user to visually compare differences between two or more DRGs. Key input variables to this section are input$var (cost measure) and input$drgcompre (a list of one or more Diagnosis Related Groups selected by the user). This section is pretty cool!
output$histogramcompare<- renderPlot({ datasetInput4 <- reactive({ switch(input$var, "average_covered_charges_ip" = average_covered_charges_ip, "average_total_payments_ip" = average_total_payments_ip, "average_medicare_payments_ip" = average_medicare_payments_ip, "total_discharges_ip" = total_discharges_ip) }) histcomparedata <- na.omit(datasetInput4()[datasetInput4()$DRG.Definition %in% c(input$drgcompare), ]) ggplot(histcomparedata, aes(x=value, fill=DRG.Definition)) + geom_density(aes(x=value, fill=DRG.Definition), alpha=.3) + theme_few() + theme(legend.position="bottom", legend.direction="vertical")+ ylab("Density") + xlab(input$var)+ ggtitle("Disease Level Comparison") + theme(legend.title=element_text(size=10)) + guides(shape=guide_legend(override.aes=list(size=100))) })
Again, above is only a few snippets of the code I develop for this CMS Shiny app. Please visit my github to view the code in its entirety.
Conclusion and Next Steps
Using this app, anyone can assess summary statistics on average covered charges, average total payments, average medicare payments and total discharges of the top 100 Medicare Severity Diagnosis Related Groups. A next step for this project is to identify whether quality of healthcare for these DRGs is associated with the average cost for these DRGs. The average cost of medicare payments for COPD w CC in California is over $2,500 greater then the same DRG in Utah; does this mean that Californian Medicare patients experience better health outcomes for this DRG? Additional datasources regarding health outcomes must be included to identify any correlation between Medicare spending and health outcomes.
About Author
