inst/app/www/R_output/tab_1_patients_quarter.R

In ocelhay/AMULaos: App on Antimicrobial Use (AMU) in Laos.

output$tab_1_patients_quarter <- renderHighchart({
  req(wards_filter())
  req(wards_filter() %>% nrow() > 1)
  
  if(input$period_display == "quarter") {
    dta_patient <- patients_filter() %>%
      mutate(spec_quarter = floor_date(surdate, "3 months")) %>% 
      mutate(spec_quarter = as.character(quarter(spec_quarter, with_year = TRUE))) %>% 
      group_by(spec_quarter, ipdopd) %>%
      summarise(n = n_distinct(patient_id), .groups = "drop")
    
    # Complete dataset
    missing <- seq(min(patients_filter()$surdate), max(patients_filter()$surdate), by = "month") %>%
      floor_date("3 months") %>%
      quarter(with_year = TRUE) %>% 
      as.character() %>% 
      unique() %>% 
      setdiff(unique(dta_patient$spec_quarter))
    
    dta_patient <- bind_rows(dta_patient, tibble(spec_quarter = missing, n = 0)) %>% 
      arrange(spec_quarter) %>%
      mutate(spec_quarter = str_replace(spec_quarter, "[.]", " Q")) %>%
      complete(spec_quarter, ipdopd, fill = list(n = 0)) %>%
      filter(!is.na(ipdopd))
    
    dta_ward <- wards_filter() %>%
      mutate(spec_quarter = floor_date(surdate, "3 months")) %>% 
      mutate(spec_quarter = as.character(quarter(spec_quarter, with_year = TRUE))) %>% 
      mutate(screened_patient = case_when(
        ipdopd == "Inpatient" ~ numadm,
        ipdopd == "Outpatient" ~ numconsu
      )) %>%
      group_by(spec_quarter, ipdopd) %>%
      summarise(nb_screened_patient = sum(screened_patient), .groups = "drop")
    
    # Complete dataset
    missing <- seq(min(wards_filter()$surdate), max(wards_filter()$surdate), by = "month") %>%
      floor_date("3 months") %>%
      quarter(with_year = TRUE) %>% 
      as.character() %>% 
      unique() %>% 
      setdiff(unique(dta_ward$spec_quarter))
    
    dta_ward <- bind_rows(dta_ward, tibble(spec_quarter = missing, nb_screened_patient = 0)) %>% 
      arrange(spec_quarter) %>%
      mutate(spec_quarter = str_replace(spec_quarter, "[.]", " Q")) %>%
      complete(spec_quarter, ipdopd, fill = list(nb_screened_patient = 0)) %>%
      filter(!is.na(ipdopd))
    
    dta <- left_join(dta_ward, dta_patient, by = c("spec_quarter", "ipdopd")) %>%
      mutate(prop_receiving_am = round(100*n / nb_screened_patient, 1))
    
    hc <- hchart(dta, type = "column", hcaes(x = spec_quarter, y = prop_receiving_am, group = ipdopd)) %>%
      hc_yAxis(title = list(text = "%"), min = 0, max = 100) %>% 
      hc_xAxis(title = "") %>%
      hc_colors(as.vector(colors_ipd_opd)[c("Inpatient" %in% dta$ipdopd, "Outpatient" %in% dta$ipdopd)]) %>%
      hc_tooltip(headerFormat = "", pointFormat = "{point.prop_receiving_am}% of screened patients received a prescription<br> {point.n} patients out 
                 of {point.nb_screened_patient} screened patients")
  }
  
  if(input$period_display == "year") {
    dta_patient <- patients_filter() %>%
      mutate(spec_year = year(surdate)) %>% 
      group_by(spec_year, ipdopd) %>%
      summarise(n = n_distinct(patient_id), .groups = "drop")
    
    dta_ward <- wards_filter() %>%
      mutate(spec_year = year(surdate)) %>% 
      group_by(spec_year, ipdopd) %>%
      mutate(screened_patient = case_when(
        ipdopd == "Inpatient" ~ numadm,
        ipdopd == "Outpatient" ~ numconsu
      )) %>%
      group_by(spec_year, ipdopd) %>%
      summarise(nb_screened_patient = sum(screened_patient), .groups = "drop")
    
    dta <- left_join(dta_ward, dta_patient, by = c("spec_year", "ipdopd")) %>%
      mutate(prop_receiving_am = round(100*n / nb_screened_patient, 1))
    
    hc <- hchart(dta, type = "column", hcaes(x = spec_year, y = prop_receiving_am, group = ipdopd)) %>%
      hc_yAxis(title = list(text = "%"), min = 0, max = 100) %>% 
      hc_xAxis(title = "") %>%
      hc_colors(as.vector(colors_ipd_opd)[c("Inpatient" %in% dta$ipdopd, "Outpatient" %in% dta$ipdopd)]) %>%
      hc_tooltip(headerFormat = "", pointFormat = "{point.prop_receiving_am}% of screened patients received a prescription<br> {point.n} patients out 
                 of {point.nb_screened_patient} screened patients")
  }
  
  return(hc)
})