Monitoring Patient Health - R Shiny Dashboard

Monitoring Patient Health

Real time monitoring of patients in the intensive care units (ICUs) is paramount as it provides nurses and physicians a timely warning or alert of a significant change in the health status of the patient.

Here, we are going to use a simple algorithm to determine the health status of a patient. In reality, patient deterioration monitoring algorithms are complex and normally requires realtime data from bedside monitors, lab results, patient health history from EMRs, and experts' judgment.

This simple algorithm uses simulated vital signs of patients. The output of the algorithm is the health status of the patient expressed from 0 to 100% --100% being perfectly healthy.

Suppose status of pateints is label into three categories as follows:

  • Stable: <80%
  • Moderate: between 80% and 90%
  • Unstable: >90%

You can access the app here.



Sever.R

In [ ]:
library(shiny)
library(dplyr)
library(ggplot2)
library(reshape2)
library(zoo)

dirname <-  '~/data'
if (!dir.exists(dirname))dir.create(dirname,recursive=TRUE)

ICU <- read.csv("data.csv", header = TRUE, stringsAsFactors = FALSE)
ICU$START_DATE <- strptime(ICU$START_DATE, format = ("%Y-%m-%d %H:%M:%S")) # if the date is as.factor, first convert it to as.character
ICU$START_DATE <- as.POSIXct(ICU$START_DATE)

#Reshape the table
ICU_cast <- na.locf(dcast(ICU, Patient_ID + START_DATE ~ Vital_Sign, mean, value.var = "Value"))

# ICU_cast <- dcast(ICU, ENCOUNTER_NUM + START_DATE ~ Vital_Sign, mean, value.var = "Value")
ICU_Cast_num <- ICU_cast %>% select(`Body Temperature`,`Diastolic Blood Pressure`,`Heart Rate`,`Oxygen Saturation`,`Respiration Rate`, `Systolic Blood Pressure`)
ICU_cast[, names(ICU_Cast_num)] <- lapply(ICU_cast[, names(ICU_Cast_num)], as.numeric)
ICU_cast$START_DATE <- strptime(ICU_cast$START_DATE, format = ("%Y-%m-%d %H:%M:%S"))
ICU_cast$START_DATE <- as.POSIXct(ICU_cast$START_DATE)
cols <- c( "Patient_ID", "Test_Date", "Temperature", "DBP", "HR", "SpO2", "RR", "SBP")
colnames(ICU_cast) <- cols

##=== Scaling Test Results===========================================================================
# Systolic Blood Pressure
for (i in 1:length(ICU_cast$SBP)){
  if (ICU_cast$SBP[i] <= 70){
    ICU_cast$sbp[i] <- 3
  }else if (ICU_cast$SBP[i] > 70 & ICU_cast$SBP[i] <=80){
    ICU_cast$sbp[i] <- 2
  }else if (ICU_cast$SBP[i] > 81 & ICU_cast$SBP[i] <=100){
    ICU_cast$sbp[i] <- 1
  }else if (ICU_cast$SBP[i] > 100 & ICU_cast$SBP[i] <= 199){
    ICU_cast$sbp[i] <- 0
  }else{
    ICU_cast$sbp[i] <- 2
  }
}
# Diastolic Blood Pressure
for (i in 1:length(ICU_cast$DBP)){
  if (ICU_cast$DBP[i] < 50){
    ICU_cast$dbp[i] <- 2
  }else if (ICU_cast$DBP[i] > 50 & ICU_cast$DBP[i] <90){
    ICU_cast$dbp[i] <- 0
  }else if (ICU_cast$DBP[i] > 90 & ICU_cast$DBP[i] <100){
    ICU_cast$dbp[i] <- 1
  }else{
    ICU_cast$dbp[i] <- 2
  }
}

# Heart Rate
for (i in 1:length(ICU_cast$HR)){
  if (ICU_cast$HR[i] <= 40){
    ICU_cast$hr[i] <- 2
  }else if (ICU_cast$HR[i] > 40 & ICU_cast$HR[i] <=50){
    ICU_cast$hr[i] <- 1
  }else if (ICU_cast$HR[i] > 50 & ICU_cast$HR[i] <=100){
    ICU_cast$hr[i] <- 0
  }else if (ICU_cast$HR[i] > 100 & ICU_cast$HR[i] <= 110){
    ICU_cast$hr[i] <- 1
  }else if (ICU_cast$HR[i] > 110 & ICU_cast$HR[i] <= 130){
    ICU_cast$hr[i] <- 2
  }else{
    ICU_cast$hr[i] <- 3
  }
}

# respiratory Rate
for (i in 1:length(ICU_cast$RR)){
  if (ICU_cast$RR[i] <= 8){
    ICU_cast$rr[i] <- 2
  }else if (ICU_cast$RR[i] > 8 & ICU_cast$RR[i] <= 14){
    ICU_cast$rr[i] <- 0
  }else if (ICU_cast$RR[i] > 14 & ICU_cast$RR[i] <=20){
    ICU_cast$rr[i] <- 1
  }else if (ICU_cast$RR[i] > 20 & ICU_cast$RR[i] <= 30){
    ICU_cast$rr[i] <- 2
  }else{
    ICU_cast$rr[i] <- 3
  }
}

# Body Temperature
for (i in 1:length(ICU_cast$Temperature)){
  if (ICU_cast$Temperature[i] <= 94){
    ICU_cast$temp[i] <- 2
  }else if (ICU_cast$Temperature[i] > 94 & ICU_cast$Temperature[i] <=101.1){
    ICU_cast$temp[i] <- 0
  }else{
    ICU_cast$temp[i] <- 2
  }
}

# simple algorithm to calculate the over-all health of a patient
ICU_cast$sum <- ICU_cast$sbp + ICU_cast$dbp + ICU_cast$hr + ICU_cast$rr + ICU_cast$temp


ICU_cast$health <- 100-100*(ICU_cast$sum)/13
ICU_cast$sum2 <- ICU_cast$SBP + ICU_cast$DBP + ICU_cast$HR + ICU_cast$RR + ICU_cast$Temperature
sum_max <- max(ICU_cast$SBP) + max(ICU_cast$DBP) + max(ICU_cast$HR) + max(ICU_cast$RR) + max(ICU_cast$Temperature)

ICU_cast$health2 <- 100*(1 - ICU_cast$sum2/sum_max)

##=============================================================================================================
shinyServer(function(input, output){

  patient <- reactive({
    input$patient
  })

  output$plot_SBP <- renderPlot({
    SBP <- ICU_cast %>% select(Patient_ID, Test_Date, SBP) %>% filter(Patient_ID==patient())

    ggplot(SBP,aes(x=Test_Date, y=SBP, color=ifelse(ICU_cast$SBP>140, "red", "blue"))) +
      geom_line(lwd=0.5, color="grey")+
      #geom_point(color=ifelse(ICU_cast$SBP>140, "red", "blue")) + 
      xlab("Test Date/Time") +
      ylab("Systolic Blood Pressure (mmHg)")+
      theme(panel.background = element_rect(fill = 'white', colour = 'gray'))
  }, height = 240)

  output$plot_DBP <- renderPlot({
    # DBP <- filter(ICU, ENCOUNTER_NUM == patient(), Vital_Sign == "Diastolic Blood Pressure")
    DBP <- ICU_cast %>% select(Patient_ID, Test_Date, DBP) %>% filter(Patient_ID==patient())

    ggplot(DBP,aes(x=Test_Date, y=DBP)) + geom_line(lwd=0.5, color="goldenrod")+ geom_point(color="goldenrod") + xlab("Test Date/Time") + ylab("Diastolic Blood Pressure (mmHg)")+
    theme(panel.background = element_rect(fill = 'white', colour = 'gray'))
  }, height = 180)


   output$plot_HR <- renderPlot({
    # HR <- filter(ICU, ENCOUNTER_NUM == patient(), Vital_Sign == "Heart Rate")
    HR <- ICU_cast %>% select(Patient_ID, Test_Date, HR) %>% filter(Patient_ID==patient())

    ggplot(HR,aes(x=Test_Date, y=HR)) + geom_line(lwd=0.5, color="red")+ geom_point(color="red") + xlab("Test Date/Time") + ylab("Heart Rate (bpm)")+
    theme(panel.background = element_rect(fill = 'white', colour = 'gray'))
  }, height = 180)

  output$plot_RR <- renderPlot({
    # RR <- filter(ICU, ENCOUNTER_NUM == patient(), Vital_Sign == "Respiration Rate")
    RR <- ICU_cast %>% select(Patient_ID, Test_Date, RR) %>% filter(Patient_ID==patient())

    ggplot(RR,aes(x=Test_Date, y=RR)) + geom_line(lwd=0.5, color="midnightblue")+ geom_point(color="midnightblue") + xlab("Test Date/Time") + ylab("Respiration Rate (bpm)")+
    theme(panel.background = element_rect(fill = 'white', colour = 'gray'))
  }, height = 180)

  output$plot_temp <- renderPlot({
    # temp <- filter(ICU, ENCOUNTER_NUM == patient(), Vital_Sign == "Body Temperature")
    temp <- ICU_cast %>% select(Patient_ID, Test_Date, Temperature) %>% filter(Patient_ID==patient())

    ggplot(temp,aes(x=Test_Date, y=Temperature)) + geom_line(lwd=0.5, color="springgreen4")+ geom_point(color="springgreen4") + xlab("Test Date/Time") + ylab("Body Temperature (F)")+
    theme(panel.background = element_rect(fill = 'white', colour = 'gray'))
  }, height = 180)

  output$plot_ox <- renderPlot({
    # ox <- filter(ICU, ENCOUNTER_NUM == patient(), Vital_Sign == "Oxygen Saturation")
    ox <- ICU_cast %>% select(Patient_ID, Test_Date, SpO2) %>% filter(Patient_ID=='Patient1')

    ggplot(ox,aes(x=Test_Date, y=SpO2)) + geom_line(lwd=0.5, color="violetred1")+ geom_point(color="violetred1") + xlab("Test Date/Time") + ylab("Oxygen Saturation (%)")+
    theme(panel.background = element_rect(fill = 'white', colour = 'gray'))
  }, height = 180)


  mean2 <- reactive({
    ICU_cast_health <- ICU_cast %>% select(Patient_ID,Test_Date, health) %>% filter(Patient_ID == patient())
    mean(ICU_cast_health$health)
  })
  output$health_status <- renderValueBox({
    if (mean2() <= 80){
      valueBox(
        format(paste0(round(mean2(),1), '%'),format="d",big.mark=","),
        "Patient Status: Stable", icon = icon("child"), color = "blue")
    }else if(mean2() > 80 & mean2() <= 90){
      valueBox(
        format(paste0(round(mean2(), 1), '%'),format="d",big.mark=","),
        "Patient Status: Moderate", icon = icon("table"), color = "yellow")
    }else{
      valueBox(
        format(paste0(round(mean2(), 1), '%'),format="d",big.mark=","),
          "Patient Status: Unstable", icon = icon("phone"), color = "red")
    }
  })
 })

ui.R

In [ ]:
library(shiny)
library(shinydashboard)
library(ggplot2)

dirname <-  '~/data'
if (!dir.exists(dirname))dir.create(dirname,recursive=TRUE)

ICU <- read.csv("data.csv", header = TRUE, stringsAsFactors = FALSE)

dashboardPage(
        skin = "blue",
        dashboardHeader(title = "Patient Monitoring System"),

        dashboardSidebar(width = 200,
                sidebarMenu(

                        selectInput('patient',
                                    label = em("Select a Patient",
                                    style="text-align:center;color:#FFA319;font-size:100%"),
                                    unique(ICU$Patient_ID), selected = "Patient1"),
                        menuItem("Patient Health", tabName = "patient_health", icon = icon("dashboard"))
                        #menuItem("Vital Signs", tabName = "vital_sign", icon = icon("dashboard"))

                          )
                        ),  #dashboardSidebar
        dashboardBody(

          tabItems(
            tabItem(tabName = "patient_health",
                    fluidRow(
                      valueBoxOutput("health_status")
                    ),

                    fluidRow(

                      box(height = 200,plotOutput("plot_SBP")),
                      box(height = 200,plotOutput("plot_DBP")),
                      box(height = 200,plotOutput("plot_HR")),
                      box(height = 200,plotOutput("plot_RR")),
                      box(height = 200,plotOutput("plot_temp")),
                      box(height = 200,plotOutput("plot_ox"))
                    )
            )
          )
        ) # end dashboardBody  
   ) # end dashboardPage