CMS DRG 2011 Shiny/R application

global.R

#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]

server.R

#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)
     }
   )
})

ui.R

# 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") ,
      
    )
))