inst/realtime/server.R

In kimjam/srms: Package to automate tasks and reporting for OCD SRMS Team.

library(shiny)

server <- function(input, output) {

  data(reagent_limits)

  df <- srms::roc_re_v26b(
    daterange = c(
      strftime(lubridate::floor_date(Sys.time(), 'month'), format = '%m-%d-%Y'),
      strftime(Sys.time(), format = '%m-%d-%Y')
    )
  ) %>%
    dplyr::filter(
      !(Call_Subject %in% c('UDA', 'MULT'))
    ) %>%
    srms::add_clre_tech(., write = FALSE)

  call_subjs <- df %>%
    dplyr::group_by(Call_Subject) %>%
    dplyr::summarise(count = n()) %>%
    dplyr::arrange(-count) %>%
    .$Call_Subject

  days_elapsed <- as.numeric(
    ceiling(difftime(Sys.time(), lubridate::floor_date(Sys.time(), 'month')))
  )

  days_in_month <- as.numeric(
    ceiling(difftime(lubridate::ceiling_date(Sys.time(), 'month'),
                     lubridate::floor_date(Sys.time(), 'month')))
  )

  output$reagtab <- DT::renderDataTable({
    reagtab <- df %>%
      dplyr::group_by(
        Technology,
        Call_Subject
      ) %>%
      dplyr::summarise(
        count = n()
      ) %>%
      dplyr::ungroup() %>%
      dplyr::left_join(
        y = reagent_limits %>%
          dplyr::filter(
            str_callsubject != 'Default'
          ) %>%
          dplyr::select(
            -Technology
          ),
        by = c('Call_Subject' = 'str_callsubject')
      )

    reagtab$Alert.Limit[reagtab$Technology == 'MicroSlide' &
                          is.na(reagtab$Alert.Limit)
                        ] <- reagent_limits$Alert.Limit[
                          reagent_limits$Technology == 'MicroSlide' &
                            reagent_limits$str_callsubject == 'Default']

    reagtab$Alert.Limit[reagtab$Technology == 'MicroTip' &
                          is.na(reagtab$Alert.Limit)
                        ] <- reagent_limits$Alert.Limit[
                          reagent_limits$Technology == 'MicroTip' &
                            reagent_limits$str_callsubject == 'Default']

    reagtab$Alert.Limit[reagtab$Technology == 'MicroWell' &
                          is.na(reagtab$Alert.Limit)
                        ] <- reagent_limits$Alert.Limit[
                          reagent_limits$Technology == 'MicroWell' &
                            reagent_limits$str_callsubject == 'Default']

    reagtab$projection <- ceiling(reagtab$count / days_elapsed * days_in_month)

    reagtab %<>%
      dplyr::filter(
        projection >= Alert.Limit
      ) %>%
      dplyr::select(
        Technology,
        Call_Subject,
        count,
        projection,
        Alert.Limit
      )

    names(reagtab) <- c('Technology', 'Call Subject',
                        'Count of Month to Date Complaints',
                        'End of Month Projection',
                        'Alert Limit'
                        )

    return(reagtab)
  })

  paretoInput <- reactive({
    srms::ggpareto(
      df = df,
      filter = paste0('Call_Subject == "',
                      input$callsubject,
                      '"')
    )$plot
  })

  output$pareto <- renderPlot({
    paretoInput()
  })

  output$callsubject <- renderUI({
    selectInput('callsubject', 'Call Subject', call_subjs)
  })

  output$dlpareto <- downloadHandler(
    filename = function() {
      paste0(input$callsubject, '_pareto', input$date, '.png')
    },
    content = function(file) {
      ggsave(file, paretoInput(), width = 12)
    }
  )

  rawparetoInput <- reactive({
    srms::ggpareto(
      df = df,
      filter = paste0('Call_Subject == "',
                      input$callsubject,
                      '"')
    )$data %>%
      dplyr::mutate(
        Call_Area = modality,
        Complaints = frequency,
        Cumulative_Percentage = paste0(round(cumperc, digits = 1), '%')
      ) %>%
      dplyr::select(
        Call_Area,
        Complaints,
        Cumulative_Percentage
      )
  })

  output$rawpareto <- renderTable({
    rawparetoInput()
  })

  output$dlparraw <- downloadHandler(
    file = function() {
      paste0(
        input$callsubject, '_pareto_raw_', input$date,
        switch(input$parfiletype, .xlsx = '.xlsx', .csv = '.csv')
      )
    },
    content = function(file) {
      switch(
        input$parfiletype,
        .xlsx = openxlsx::write.xlsx(x = rawparetoInput(), file),
        .csv = write.csv(x = rawparetoInput(), file, row.names = FALSE)
      )
    }
  )

  # raw data output
  rawdataInput <- reactive({
    rawdf <- df
    names(rawdf)[1:7] <- c('YYYYMM', 'Analyzer', 'Family_Code',
                           'Product_Number', 'Call_Subject', 'Call_Area',
                           'Complaint_Nbr')

    names(rawdf)[(ncol(rawdf)-1):ncol(rawdf)] <- c('startdate', 'enddate')

    rawdf[sapply(rawdf, class) %in% c('numeric', 'integer')] <- lapply(
      rawdf[sapply(rawdf, class) %in% c('numeric', 'integer')], factor)

    rawdf$Call_Subject <- factor(rawdf$Call_Subject)
    rawdf$Call_Area <- factor(rawdf$Call_Area)
    rawdf %<>%
      dplyr::select(
        -Device_Count,
        -startdate,
        -enddate
      )
    return(rawdf)
  })

  output$rawdf <- DT::renderDataTable(
    rawdataInput(), filter = 'top', server = FALSE, selection = 'none'
  )

  output$dlrawdata <- downloadHandler(
    filename = function() {
      paste0(
        'rawdata.', switch(input$rawdatafiletype, .xlsx = 'xlsx', .csv = 'csv')
      )
    },
    content = function(file) {
      s = input$rawdf_rows_all
      switch(
        input$rawdatafiletype,
        .xlsx = openxlsx::write.xlsx(x = rawdataInput()[s, , drop = FALSE ], file),
        .csv = write.csv(x = rawdataInput()[s, , drop = FALSE ], file,
                         row.names = FALSE)
      )
    }
  )
}