# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at https://mozilla.org/MPL/2.0/.
#' Interface elements of dMeasure Billings
#'
#' requires R6 methods from QualityImprovementMeasures.R
#'
#' @include QualityImprovementMeasures.R
#'
#' require UI (and server) functions from sub-modules
#'
#' @include QIM_15plus_UI.R
#' @include QIM_65plus_UI.R
#' @include QIM_active_UI.R
#' @include QIM_copd_UI.R
#' @include QIM_cst_UI.R
#' @include QIM_cvdRisk_UI.R
#' @include QIM_diabetes_UI.R
#' @include QIM_report_UI.R
NULL
###########################################################
#' item description for left sidebar menu
#'
#' @name shinydashboardmenuItem
#'
#' @return shinydashboard menuItem object
#'
#' @export
shinydashboardmenuItem <- function() {
x <- list(
shinydashboard::sidebarMenu(
.list = list(
shinydashboard::menuItem(
"PIP Quality Improvement",
tabName = "qimRept",
icon = shiny::icon("chart-line")
),
shinydashboard::menuItem(
"QIM Appointment",
tabName = "qimAppt",
icon = shiny::icon("chart-line")
)
)
)
)
return(x)
}
#' center panel description
#'
#' @name dMeasureShinytabItems
#'
#' @return shinytabItems
#'
#' @export
dMeasureShinytabItems <- function() {
x <- c(
list(shinydashboard::tabItem(
tabName = "qimRept",
shiny::fluidRow(column(
width = 12, align = "center",
h2("Quality Improvement Measure Reporting")
)),
shiny::fluidRow(column(
width = 12,
dMeasureQIM::datatableUI("qimRept")
))
)),
list(shinydashboard::tabItem(
tabName = "qimAppt",
shiny::fluidRow(column(
width = 12, align = "center",
h2("Quality Improvement Measure Appointment View")
)),
shiny::fluidRow(column(
width = 12,
dMeasureQIM::datatableUI("qimAppt")))
))
)
return(x)
}
#' QIM module - UI function
#'
#' Display appointments within selected range of dates and providers
#'
#' @name datatableUI
#'
#' @param id module ID (used in conjunction with 'callModule')
#'
#' @return Shiny user interface element
#'
#' @export
datatableUI <- function(id) {
ns <- shiny::NS(id)
shiny::div(
id = ns("qim_datatable_wrapper"),
shiny::fluidRow(
shiny::tagList(
shiny::uiOutput(ns("tabs"))
)
)
)
}
#' QIM module - server for DailyMeasure/GPstat! web UI
#'
#' @name datatableServer
#'
#' @param id id
#' @param dMQIM dMeasure QIM R6 object
#' @param contact (logical) TRUE if using 'contact' list
#' 'contact' list uses active contact methods
#' FALSE if using 'appointment' list
#'
#' @return none
#'
#' @export
datatableServer <- function(id, dMQIM, contact) {
if (contact == FALSE) {
dMQIM$qim_contact <- FALSE
# uses appointment list, not contact list
dMQIM$qim_demographicGroup <- c("")
# by default, the 'appointment' module does not show QIM aggregate groups
}
shiny::moduleServer(id, function(input, output, session) {
ns <- session$ns
# convoluted mechanism to create a tabPanel which responds
# to 'contact' variable
#
# https://github.com/rstudio/shinydashboard/issues/98
#
# unable to place a uiOutput (which works) within a
# shinydashboard::tabBox,
# and insertTab/appendTab/removeTab etc. don't work
# inside a tabBox
tabs.content <- list(
list(
title = "Diabetes",
width = 12,
shiny::br(),
dMeasureQIM::qim_diabetes_UI(ns("qim_diabetes"))
),
list(
title = "Cervical Screening",
width = 12,
shiny::br(),
dMeasureQIM::qim_cst_UI(ns("qim_cst"))
),
list(
title = "15+",
width = 12,
shiny::br(),
dMeasureQIM::qim_15plus_UI(ns("qim_15plus"))
),
list(
title = "65+",
width = 12,
shiny::br(),
dMeasureQIM::qim_65plus_UI(ns("qim_65plus"))
),
list(
title = "COPD (Lung Disease)",
width = 12,
shiny::br(),
dMeasureQIM::qim_copd_UI(ns("qim_copd"))
),
list(
title = "Cardiovascular risk",
width = 12,
shiny::br(),
dMeasureQIM::qim_cvdRisk_UI(ns("qim_cvdRisk"))
)
)
if (contact) {
# only show the 'Active' and 'Create Report' panel if contact list
#
# 'Active' is whether the patient qualifies as 'active' depending
# on criteria such as appointments, visits (recordings in the file)
# or billings over a defined time period, and a certain number of
# times
#
# e.g. one definition of 'active' is 3 'visits' over 2 years
# though an alternative definition could be three 'billings' over
# three years
tabs.content <- append(
list(list(
title = "Active",
width = 12,
shiny::br(),
dMeasureQIM::qim_active_UI(ns("qim_active"))
)),
tabs.content
)
tabs.content <- append(
tabs.content,
list(
list(
title = "Report creator",
value = "reportCreator",
width = 12,
shiny::br(),
dMeasureQIM::qim_reportCreator_UI(ns("qim_reportCreator"))
),
list(
title = "Report charter",
value = "reportCharter",
width = 12,
shiny::br(),
dMeasureQIM::qim_reportCharter_UI(ns("qim_reportCharter"))
)
)
)
}
tabs <- lapply(
1:length(tabs.content),
function(i) do.call(tabPanel, tabs.content[[i]])
)
tabs <- append(
list(
id = ns("tab_qim"),
title = shiny::tagList(
shiny::div(
style = "display:inline-block",
shiny::uiOutput(ns("settings_group"))
),
shiny::div(
style = "display:inline-block",
"Quality Improvement Measures"
)
),
width = 12,
height = "85vh"
),
tabs
)
output$tabs <- renderUI({
do.call(shinydashboard::tabBox, tabs)
})
# result management
callModule(dMeasureQIM::qim_diabetes, "qim_diabetes", dMQIM, contact)
callModule(dMeasureQIM::qim_cst, "qim_cst", dMQIM, contact)
callModule(dMeasureQIM::qim_15plus, "qim_15plus", dMQIM, contact)
callModule(dMeasureQIM::qim_65plus, "qim_65plus", dMQIM, contact)
callModule(dMeasureQIM::qim_copd, "qim_copd", dMQIM, contact)
callModule(dMeasureQIM::qim_cvdRisk, "qim_cvdRisk", dMQIM, contact)
if (contact) {
# only in 'contact' mode
callModule(dMeasureQIM::qim_active, "qim_active", dMQIM, contact)
report_creator <- callModule(
dMeasureQIM::qim_reportCreator, "qim_reportCreator",
dMQIM, report_charter
)
report_charter <- callModule(
dMeasureQIM::qim_reportCharter, "qim_reportCharter",
dMQIM, report_creator
)
}
initial_demographic <- dMQIM$qim_demographicGroup
# this is an unusual kludge, for some reason specifying dMQIM$qim_demographicGroup
# in the 'choices' of checkboxGroupButtons does not work
demographic_chosen <- shiny::reactiveVal(
initial_demographic
)
output$settings_group <- shiny::renderUI({
shinyWidgets::dropMenu(
shiny::actionButton(
inputId = ns("qim_dropdown"),
icon = shiny::icon("gear"),
label = "Settings"
),
shiny::tags$div(
shinyWidgets::checkboxGroupButtons(
inputId = ns("ignore_old"),
label = "Measurements",
checkIcon = list(
yes = shiny::icon("calendar-times"),
no = shiny::icon("calendar-alt")
),
choices = c("Ignore old measurements"),
selected = c("Ignore old measurements"),
status = "primary"
),
shinyWidgets::checkboxGroupButtons(
inputId = ns("demographic_chosen"),
label = "Demographic grouping",
choices = dMQIM$qim_demographicGroupings,
selected = demographic_chosen(),
status = "primary",
checkIcon = list(yes = shiny::icon("ok", lib = "glyphicon"))
)
)
)
})
shiny::observeEvent(
input$qim_dropdown_dropmenu,
ignoreInit = TRUE, {
# this is triggered when shinyWidgets::dropMenu is opened/closed
# tag is derived from the first tag in dropMenu, adding '_dropmenu'
if (!input$qim_dropdown_dropmenu) {
# only if closing the 'dropmenu' modal
# unfortunately, is also triggered during Init (despite the ignoreInit)
demographic_chosen(input$demographic_chosen)
}
}
)
shiny::observeEvent(demographic_chosen(), ignoreNULL = FALSE, {
# change the filter depending on the dropdown
dMQIM$qim_demographicGroup <- demographic_chosen()
})
shiny::observeEvent(input$ignore_old, ignoreNULL = FALSE, {
# if selected, will filter out appointments older than current date
dMQIM$qim_ignoreOld <- ("Ignore old measurements" %in% input$ignore_old)
})
})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.