Created
June 14, 2013 18:37
-
-
Save klittle314/5784204 to your computer and use it in GitHub Desktop.
CMS DRG 2011 Shiny/R application
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#global.R | |
#This is the set up of the data files for use in the Map DRG 100 example | |
# We create the master data file which will be subsetted by the Shiny application. The data file is in the working directory for the app | |
# Kevin Little, Ph.D., 13 June 2013 klittle@iecodesign.com | |
# app requires ggplot2 and googleVis packages | |
#example from CMS requires package ggplot2 | |
d1<-read.csv("CMSexample.csv", colClasses="character") | |
summary(d1) | |
for(i in 9:11){ | |
d1[,i]<-as.numeric(d1[,i]) | |
} | |
#Calculate per cent payment | |
d1$pctCMS<-100*d1[,11]/d1[,10] | |
#functions to extract first n characters of a string | |
substrLeft <- function(x, n){ | |
substr(x, 1, n) | |
} | |
#Extract DRG code from DRG definition | |
d1$DRGcode<-as.factor(substrLeft(d1[,1],3)) | |
for(i in c(1,2,3,6,8)){ | |
d1[,i]<-as.factor(d1[,i]) | |
} | |
#create a factor based whether or not the percent payment is more than 100% | |
d1$PercentCheck<-ifelse(d1$pctCMS>100,"pct>100","pct<=100") | |
# order the DRG by the median of the overall charges | |
medianScore<-tapply(d1$Average.Covered.Charges,d1$DRGcode,median) | |
d1$DRGorder<-reorder(d1$DRGcode,d1$Average.Covered.Charges,FUN=median,order=is.ordered(d1$DRGcode)) | |
#if want to sort in reverse order, need trick used in Dashboard code, apply function to negative of the values | |
medianScoreOrder<-tapply(d1$Average.Covered.Charges,d1$DRGorder,median) | |
#create the character vector to hold the 100 DRG names to be used in the drop down box | |
DRGName<-levels(d1$DRG.Definition) | |
names(DRGName)<-DRGName | |
#Transform the average charges and payments to totals by multiplying the averages by the number of cases | |
d1$TotalCovCharges<-d1[,9]*d1[,10] | |
d1$TotalPayments<-d1[,9]*d1[,11] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#server.R | |
#accept input string of data file name from ui, subset the main data file; pass back a map (Google visualization API element), a | |
#small multiples display produced by ggplot2 and a data file that is the subset used to create the displays. | |
library(googleVis) | |
suppressPackageStartupMessages(library(googleVis)) | |
shinyServer(function(input, output) { | |
datasetInput1 <- reactive({ | |
cat(as.character(paste(input$dataset," "))) | |
d3<-d1[d1[,1]==input$dataset,] | |
}) | |
datasetInput2 <- reactive({ | |
cat(as.character(paste(input$dataset," "))) | |
#create the summary variables by state | |
dfHospCount<-as.data.frame(table(datasetInput1()$Provider.State)) | |
sumDC<-as.data.frame(tapply(datasetInput1()$Total.Discharges,datasetInput1()$Provider.State,sum)) | |
sumTCC<-as.data.frame(tapply(datasetInput1()$TotalCovCharges,datasetInput1()$Provider.State,sum)) | |
sumTP<-as.data.frame(tapply(datasetInput1()$TotalPayments,datasetInput1()$Provider.State,sum)) | |
states<-levels(datasetInput1()$Provider.State) | |
#need to use the syntax cbind.data.frame to preserve the numeric values in the binding. | |
df<-cbind.data.frame(states,dfHospCount$Freq,sumDC[,1],sumTCC[,1],sumTP[,1]) | |
#calculate the statewise summary values for percent of payments vs charges; payments; charges | |
df$Pct<-round(100*df[,5]/df[,4],1) | |
df$AvgPay<-round(df[,5]/df[,3],2) | |
df$AvgCharge<-round(df[,4]/df[,3],2) | |
df1<-df | |
}) | |
#create the U.S. map using the Google visualization API element | |
output$view2 <- renderGvis({ | |
gvisGeoChart(datasetInput2(),"states","Pct", options=list(region="US",displayMode="regions", resolution="provinces", | |
width=500, height=250,title="Percent Paid, Median of Hospital Averages")) | |
}) | |
#create the small multiples display using the ggplot2 package | |
output$view1 <- renderPlot({ | |
p12<-ggplot(datasetInput1(),aes(Average.Covered.Charges,Average.Total.Payments,colour=PercentCheck)) | |
p13<-p12+facet_wrap(~Provider.State, ncol=7)+ | |
geom_point(size=2.5,shape=1)+ | |
theme_bw()+ | |
theme(axis.text.x=element_text(angle=-45,vjust=0.75,hjust=0.1,size=8))+ | |
theme(axis.text.y=element_text(size=7))+ | |
xlab("Average Charges ($)")+ | |
ylab("CMS Average Payments ($)")+ | |
ggtitle(paste("2011 CMS Hospital records for DRG ", input$dataset)) | |
#for ggplot2 to render the display, need explicit print call | |
print(p13) | |
},height=500) | |
#create the file for download | |
output$dataDownload<-downloadHandler( | |
filename = function() { paste(input$dataset, '.csv', sep='') }, | |
content = function(file) { | |
write.csv(datasetInput1(), file) | |
} | |
) | |
}) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# ui.R | |
#This works to put a nice long list in the drop down box, in this case, in the global.R I set up the names in a character | |
#vector DRGName. | |
shinyUI(pageWithSidebar( | |
headerPanel("2011 CMS $ Charged and Paid by DRG"), | |
sidebarPanel( | |
selectInput("dataset", "Choose a DRG:", | |
choices = DRGName), | |
downloadButton("dataDownload", "Download DRG data set"), | |
helpText("The U.S. map is produced by the Google visualization suite and shows each state's | |
payments vs charges, as a percent. The small multiples display is produced by the ggplot2 package in R. | |
The download data set provides all the information to reproduce the displays.") | |
), | |
#Make a display | |
mainPanel( | |
htmlOutput("view2"), | |
plotOutput("view1") | |
#htmlOutput("view1") , | |
) | |
)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment