# 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/.
#' @name qim_report_UI
#' @title dMeasure Quality Improvement Measures - reports for QIM UI
#'
#' need definitions including 'measure_names'
#'
#' @include QualityImprovementMeasures.R
NULL
#' @export
qim_reportCreator_UI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
shiny::fluidRow(
shiny::column(
width = 4,
shiny::wellPanel(
style = "height:15em",
shiny::tags$h5("Contact period"),
shiny::fluidRow(
shiny::column(
width = 6,
shiny::dateInput(
inputId = ns("report_endDate"),
label = "Up to:",
format = "D dd/M/yyyy",
min = Sys.Date() - 9000,
value = Sys.Date()
)
),
shiny::column(
width = 6,
shinyWidgets::pickerInput(
inputId = ns("report_duration_n"),
label = "Duration",
choices = 1:30,
multiple = FALSE,
selected = "24"
),
shinyWidgets::pickerInput(
inputId = ns("report_duration_unit"),
label = "",
choices = c("Days", "Weeks", "Months"),
multiple = FALSE,
selected = "Months"
)
)
)
)
),
shiny::column(
width = 4,
shiny::wellPanel(
style = "height:15em",
shiny::tags$h5("Minimum contacts"),
shiny::fluidRow(
shiny::column(
width = 6,
shinyWidgets::pickerInput(
inputId = ns("report_contact_type"),
label = "Contact types",
choices = c("Appointments", "Visits", "Services"),
selected = "Services",
options = list(
style = "btn-primary",
`actions-box` = TRUE
),
multiple = TRUE
)
),
shiny::column(
width = 6,
shinyWidgets::sliderTextInput(
inputId = ns("report_min_contact"),
label = "Minimum number of contacts",
choices = c(1:10),
grid = TRUE,
selected = 3
)
)
)
)
),
shiny::column(
width = 4,
shiny::wellPanel(
style = "height:15em",
shiny::tags$h5("QIM Measures"),
shinyWidgets::pickerInput(
inputId = ns("report_qim_chosen"),
label = "",
choices = measure_names,
selected = measure_names,
# consult choices initially selected
options = list(
style = "btn-primary",
`actions-box` = TRUE
),
multiple = TRUE
)
)
)
),
shiny::fluidRow(
shiny::column(
width = 4,
shiny::wellPanel(
style = "height:25em",
shiny::tags$h5("Create report"),
shiny::fluidRow(
shiny::column(
width = 3,
shiny::actionButton(
inputId = ns("report_createReport"),
label = "Go!"
)
),
shiny::column(
width = 9,
shiny::div(
class = "parent",
style = "text-align: left",
shiny::div(
style = "display: inline-block; vertical-align: top",
shinyWidgets::awesomeCheckboxGroup(
inputId = ns("report_filter_options"),
label = "",
choices = c(
"Small cell suppression",
"Include all demographics groups"
),
selected = c("Include all demographics groups")
)
),
shiny::div(
style = "display: inline-block; vertical-align:-50%",
# '-50%' still results in a '+50%' compared to the h3 title!
# '-100%' results in a dropdown widget roughly in line with the title
shinyWidgets::dropdown(
shiny::tags$h4("Small cell suppression"),
"Suppress (return NA 'not available') if group size (i.e. denominator) is less than 5",
shiny::br(),shiny::br(),
"This means of avoiding disclosure of information regarding specific patients is explictly allowed under",
shiny::tags$a(
href = "https://www1.health.gov.au/internet/main/publishing.nsf/Content/46506AF50A4824B6CA25848600113FFF/$File/PIP-QI-User-Guide-Practices.pdf",
"Practice Incentives Program Quality Improvement Incentives Quality Improvement Measures User Guide for General Practices (2020)",
),
" Section 2.7 'Is the data de-identified?', page 8.",
shiny::br(),shiny::br(),
shiny::tags$h4("Include all demographics groups"),
"Include all possible groups and subgroups, even if",
"there are no patients in the group.",
shiny::br(), shiny::br(),
status = "primary",
size = "xs",
width = "600px",
icon = icon("question-circle"),
animate = shinyWidgets::animateOptions(
enter = shinyWidgets::animations$fading_entrances$fadeIn,
exit = shinyWidgets::animations$fading_exits$fadeOut
),
tooltip = shinyWidgets::tooltipOptions(
placement = "top",
title = "Server description details"
)
)
)
)
)
),
shiny::hr(),
shiny::tags$h5("Number of reports"),
shiny::fluidRow(
shiny::column(
width = 6,
shinyWidgets::sliderTextInput(
inputId = ns("report_number"),
label = "Number",
choices = c(1:10),
grid = TRUE,
selected = 1
)
),
shiny::column(
width = 6,
shinyWidgets::pickerInput(
inputId = ns("report_spacing_n"),
label = "Spacing",
choices = 1:30,
multiple = FALSE,
selected = "1"
),
shinyWidgets::pickerInput(
inputId = ns("report_spacing_unit"),
label = "",
choices = c("Days", "Weeks", "Months"),
multiple = FALSE,
selected = "Months"
)
)
)
)
),
shiny::column(
width = 4,
shiny::wellPanel(
style = "height:25em",
shiny::tags$h5("Report store/save"),
shiny::hr(),
shiny::tags$h6("CSV 'spreadsheet' download"),
shiny::icon("download"),
shinyjs::disabled(
# enable when there is something to save...
shinyFiles::shinySaveButton(
id = ns("csv_filename"),
label = "Download CSV file",
title = "Download CSV file - choose CSV filename",
filename = paste0("QIMReport-", Sys.Date()),
filetype = list(spreadsheet = c('csv'))
)
),
shiny::hr(),
shiny::tags$h6("JSON 'PIP' download"),
shiny::icon("download"),
shinyjs::disabled(
# enable when there is something to save...
shinyFiles::shinySaveButton(
id = ns("json_filename"),
label = "Download JSON file",
title = "Download JSON file - choose JSON filename",
filename = paste0("QIMReport-", Sys.Date()),
filetype = list(json = c('json'))
)
)
)
)
)
)
}
#' Quality Improvement report creation - server
#'
#' @param input as required by Shiny modules
#' @param output as required by Shiny modules
#' @param session as required by Shiny modules
#' @param dMQIM dMeasure QIM R6 object
#' access to appointments lists, results, correspondence and EMR database
#' @param report a list returned by qim_reportCharter
#' should contain $report_values(), which is a dataframe
#'
#' @return list with following components
#' \describe{
#' \item{report_values}{dataframe of report}
#' }
#'
#' @export
qim_reportCreator <- function(input, output, session, dMQIM, report) {
ns <- session$ns
volumes <- c(Home = fs::path_home(), shinyFiles::getVolumes()())
shinyFiles::shinyFileSave(
input, id = "csv_filename", roots = volumes, session = session,
restrictions = system.file(package = "base")
)
shinyFiles::shinyFileSave(
input, id = "json_filename", roots = volumes, session = session,
restrictions = system.file(package = "base")
)
empty_result <- data.frame(
QIM = character(),
Age10 = numeric(),
Sex = character(),
Indigenous = character(),
DiabetesType = character(),
Measure = character(),
State = character(),
n = numeric(),
ProportionDemographic = numeric(),
DateFrom = character(),
DateTo = character()
)
report_values <- reactiveVal(empty_result)
shiny::observeEvent(
report_values(),
ignoreInit = FALSE, ignoreNULL = FALSE, {
if (is.null(report_values()) || nrow(report_values()) == 0) {
# disable download button if nothing to download
shinyjs::disable("csv_filename")
shinyjs::disable("json_filename")
} else {
shinyjs::enable("csv_filename")
shinyjs::enable("json_filename")
}
}
)
shiny::observeEvent(
input$report_createReport,
ignoreInit = TRUE, {
shiny::req(length(input$report_qim_chosen) > 0)
# need to have at least one report to write
# prepare a data frame
report_values(empty_result)
date_to <- input$report_endDate
date_from <- seq.Date(
date_to,
by = paste0(
"-", as.numeric(input$report_duration_n),
" ",
stringi::stri_sub(
tolower(input$report_duration_unit), 1, -2
)
),
length.out = 2
)[[2]] # only take the 'end' of the sequence
min_contact = input$report_min_contact
contact_type = input$report_contact_type
if (input$report_number > 1) {
# create progress bar
report_progress <- shiny::Progress$new(
session, min = 0, max = input$report_number
)
# close progress bar when function exits
on.exit(report_progress$close())
# initialize
report_progress$set(
message = "Calculating report",
detail = "1",
value = 0
)
}
small_cell_suppression <- "Small cell suppression" %in%
input$report_filter_options
include_all_demographic_groups <- "Include all demographics groups" %in%
input$report_filter_options
for (i in 1:input$report_number) {
# in this case, we can be confident that input$report_number
# is not a negative number or zero!
# create progress bar
progress <- shiny::Progress$new(
session, min = 0, max = length(input$report_qim_chosen)
)
# initialize
progress$set(
message = "Calculating measure",
value = 0
)
qim <- empty_result
if (measure_names[[1]] %in% input$report_qim_chosen) {
qim01 <- getReport(
dMQIM$report_qim_diabetes,
date_from = date_from, date_to = date_to,
contact_type = contact_type, min_contact = min_contact,
progress = progress, progress_detail = "QIM 01 - Diabetes HbA1C",
measure = "HbA1C", require_type_diabetes = TRUE,
qim_name = "QIM 01", measure_name = "HbA1C",
state_variable_name = dplyr::quo(HbA1CDone),
small_cell_suppression = small_cell_suppression,
include_all_demographic_groups = include_all_demographic_groups
)
qim <- rbind(qim, qim01)
}
if (measure_names[[2]] %in% input$report_qim_chosen) {
qim02 <- getReport(
dMQIM$report_qim_15plus,
date_from = date_from, date_to = date_to,
contact_type = contact_type, min_contact = min_contact,
progress = progress, progress_detail = "QIM 02 - 15+ smoking",
measure = "Smoking", require_type_diabetes = FALSE,
qim_name = "QIM 02", measure_name = "Smoking",
state_variable_name = dplyr::quo(SmokingStatus),
small_cell_suppression = small_cell_suppression,
include_all_demographic_groups = include_all_demographic_groups
)
qim <- rbind(qim, qim02)
}
if (measure_names[[3]] %in% input$report_qim_chosen) {
qim03 <- getReport(
dMQIM$report_qim_15plus,
date_from = date_from, date_to = date_to,
contact_type = contact_type, min_contact = min_contact,
progress = progress, progress_detail = "QIM 03 - 15+ BMI Class",
measure = "Weight", require_type_diabetes = FALSE,
qim_name = "QIM 03", measure_name = "BMIClass",
state_variable_name = dplyr::quo(BMIClass),
small_cell_suppression = small_cell_suppression,
include_all_demographic_groups = include_all_demographic_groups
)
qim <- rbind(qim, qim03)
}
if (measure_names[[4]] %in% input$report_qim_chosen) {
qim04 <- getReport(
dMQIM$report_qim_65plus,
date_from = date_from, date_to = date_to,
contact_type = contact_type, min_contact = min_contact,
min_date = dMeasure::add_age(date_to, 1, "-15 month"),
# according to PIP QI Improvement Measures Technical Specifications V1.2 (22102020)
# QIM 04, page 16
#
# Exclude clients from the calculation if they:
# - did not have the immunisation due to documented medical reasons (e.g. allergy),
# system reasons (vaccine not available),or patient reasons (e.g. refusal);
# - or had results from measurements conducted outside of the service which were not available to the service
# and had not visited the service in the previous 15 months.
#
# by the second exclusion criteria, the most recent contact must be within 15 months
# of the 'date_to' report date (although 'date_from' could be different to that, as
# by default the period for contact calculation is 2 years before 'date_to')
#
# presumably if a person *was* vaccinated at the clinic within the past 15 months,
# then the person has also visited the clinic within the last 15 months
progress = progress, progress_detail = "QIM 04 - 65+ Influenza",
measure = NA, require_type_diabetes = FALSE,
qim_name = "QIM 04", measure_name = "InfluenzaDone",
state_variable_name = dplyr::quo(InfluenzaDone),
small_cell_suppression = small_cell_suppression,
include_all_demographic_groups = include_all_demographic_groups
)
qim <- rbind(qim, qim04)
}
if (measure_names[[5]] %in% input$report_qim_chosen) {
qim05 <- getReport(
dMQIM$report_qim_diabetes,
date_from = date_from, date_to = date_to,
contact_type = contact_type, min_contact = min_contact,
progress = progress, progress_detail = "QIM 05 - Diabetes Influenza",
measure = "Influenza", require_type_diabetes = TRUE,
qim_name = "QIM 05", measure_name = "InfluenzaDone",
state_variable_name = dplyr::quo(InfluenzaDone),
small_cell_suppression = small_cell_suppression,
include_all_demographic_groups = include_all_demographic_groups
)
qim <- rbind(qim, qim05)
}
if (measure_names[[6]] %in% input$report_qim_chosen) {
qim06 <- getReport(
dMQIM$report_qim_copd,
date_from = date_from, date_to = date_to,
contact_type = contact_type, min_contact = min_contact,
progress = progress, progress_detail = "QIM 06 - COPD Influenza",
measure = NA, require_type_diabetes = FALSE,
qim_name = "QIM 06", measure_name = "InfluenzaDone",
state_variable_name = dplyr::quo(InfluenzaDone),
small_cell_suppression = small_cell_suppression,
include_all_demographic_groups = include_all_demographic_groups
)
qim <- rbind(qim, qim06)
}
if (measure_names[[7]] %in% input$report_qim_chosen) {
qim07 <- getReport(
dMQIM$report_qim_15plus,
date_from = date_from, date_to = date_to,
contact_type = contact_type, min_contact = min_contact,
progress = progress, progress_detail = "QIM 07 - 15+ Alcohol",
measure = "Alcohol", require_type_diabetes = FALSE,
qim_name = "QIM 07", measure_name = "AlcoholDone",
state_variable_name = dplyr::quo(AlcoholDone),
small_cell_suppression = small_cell_suppression,
include_all_demographic_groups = include_all_demographic_groups
)
qim <- rbind(qim, qim07)
}
if (measure_names[[8]] %in% input$report_qim_chosen) {
qim08 <- getReport(
dMQIM$report_qim_cvdRisk,
date_from = date_from, date_to = date_to,
contact_type = contact_type, min_contact = min_contact,
progress = progress, progress_detail = "QIM 08 - CVD Risk",
measure = NA, require_type_diabetes = FALSE,
qim_name = "QIM 08", measure_name = "CVDRiskDone",
state_variable_name = dplyr::quo(CVDriskDone),
small_cell_suppression = small_cell_suppression,
include_all_demographic_groups = include_all_demographic_groups
)
qim <- rbind(qim, qim08)
}
if (measure_names[[9]] %in% input$report_qim_chosen) {
qim09 <- getReport(
dMQIM$report_qim_cst,
date_from = date_from, date_to = date_to,
contact_type = contact_type, min_contact = min_contact,
progress = progress, progress_detail = "QIM 09 - Cervical screening",
measure = NA, require_type_diabetes = FALSE,
qim_name = "QIM 09", measure_name = "CSTDone",
state_variable_name = dplyr::quo(CSTDone),
small_cell_suppression = small_cell_suppression,
include_all_demographic_groups = include_all_demographic_groups
)
qim <- rbind(qim, qim09) }
if (measure_names[[10]] %in% input$report_qim_chosen) {
qim10 <- getReport(
dMQIM$report_qim_diabetes,
date_from = date_from, date_to = date_to,
contact_type = contact_type, min_contact = min_contact,
progress = progress, progress_detail = "QIM 10 - Diabetes BP",
measure = "BP", require_type_diabetes = TRUE,
qim_name = "QIM 10", measure_name = "BPDone",
state_variable_name = dplyr::quo(BPDone),
small_cell_suppression = small_cell_suppression,
include_all_demographic_groups = include_all_demographic_groups
)
qim <- rbind(qim, qim10)
}
report_values(
rbind(
report_values(),
qim %>>%
dplyr::select(QIM, Age10, Sex, Indigenous, DiabetesType, Measure,
State, n, ProportionDemographic) %>>%
dplyr::arrange(QIM, Age10, Sex, Indigenous, DiabetesType, State) %>>%
dplyr::mutate(
DateFrom = date_from, DateTo = date_to,
ContactType = paste(contact_type, collapse = ", "),
MinContact = min_contact,
Clinicians = paste(dMQIM$dM$clinicians, collapse = ", ")
)
)
)
# close QIM progress bar
progress$close()
if (input$report_number > 1) {
# update progress bar
report_progress$inc(
amount = 1,
detail = as.character(min(i + 1, input$report_number))
)
# update dates for next loop
report_spacing <- paste0(
"-", as.numeric(input$report_spacing_n),
" ",
stringi::stri_sub(
tolower(input$report_spacing_unit), 1, -2
)
)
date_from <- seq.Date(
date_from,
by = report_spacing,
length.out = 2
)[[2]]
date_to <- seq.Date(
date_to,
by = report_spacing,
length.out = 2
)[[2]]
}
}
})
shiny::observeEvent(
input$csv_filename,
ignoreInit = TRUE, ignoreNULL = TRUE, {
shiny::req(input$csv_filename) # can't be NULL/empty
datapath <- shinyFiles::parseSavePath(volumes, input$csv_filename) %>>%
dplyr::pull(datapath)
if (length(datapath)) {
# if length 0 (i.e. datapath == character(0), then return empty string)
write.csv(report_values(), file = datapath, row.names = FALSE)
}
}
)
# if json_filename clicked,
# then ask various questions about which data to export
# and author/practice ID and small cell suppression
shiny::observeEvent(
input$json_filename,
ignoreInit = TRUE, ignoreNULL = TRUE, {
shiny::req(input$json_filename) # can't be NULL/empty
datapath <- shinyFiles::parseSavePath(volumes, input$json_filename) %>>%
dplyr::pull(datapath)
unique_DateTo <- unique(report_values()$DateTo)
if (length(datapath)) {
# if length 0 (i.e. datapath == character(0), then return empty string)
shiny::showModal(shiny::modalDialog(
title = "Practice Incentive Program JSON attributes",
shiny::selectInput(
inputId = ns("json_DateTo"),
label = "'Date To' of period",
choices = unique_DateTo
),
shiny::textInput(
inputId = ns("json_author_id"),
label = "Author ID",
value = "bpsrawdata"
),
shiny::textInput(
inputId = ns("json_practice_id"),
label = "Practice ID",
value = "",
placeholder = "Your practice ID"
),
shiny::div(
class = "parent",
style = "text-align: left",
shiny::div(
style = "display: inline-block; vertical-align: top",
shiny::checkboxInput(
# denominator less than five
inputId = ns("json_small_cell_suppression"),
label = "Small cell suppression",
width = "100%",
value = TRUE
)
),
shiny::div(
style = "display: inline-block; vertical-align:-50%",
# '-50%' still results in a '+50%' compared to the h3 title!
# '-100%' results in a dropdown widget roughly in line with the title
shinyWidgets::dropdown(
shiny::tags$h4("Small cell suppression"),
"Suppress (return NA 'not available') if group size (i.e. denominator) is less than 5",
shiny::br(),shiny::br(),
"This means of avoiding disclosure of information regarding specific patients is explictly allowed under",
shiny::tags$a(
href = "https://www1.health.gov.au/internet/main/publishing.nsf/Content/46506AF50A4824B6CA25848600113FFF/$File/PIP-QI-User-Guide-Practices.pdf",
"Practice Incentives Program Quality Improvement Incentives Quality Improvement Measures User Guide for General Practices (2020)",
),
" Section 2.7 'Is the data de-identified?', page 8.",
shiny::br(),shiny::br(),
status = "primary",
size = "xs",
width = "600px",
icon = icon("question-circle"),
animate = shinyWidgets::animateOptions(
enter = shinyWidgets::animations$fading_entrances$fadeIn,
exit = shinyWidgets::animations$fading_exits$fadeOut
),
tooltip = shinyWidgets::tooltipOptions(
placement = "top",
title = "Server description details"
)
)
)
),
shiny::div(
class = "parent",
style = "text-align: left",
shiny::div(
style = "display: inline-block; vertical-align: top",
shiny::checkboxInput(
# this is a type of probability-based suppression
# where 'almost' all of the group shares the same characteristic
# i.e. almost all 'FALSE' or all 'TRUE'
inputId = ns("json_group_identification_suppression"),
label = "Group identification suppression",
value = FALSE,
width = "100%"
)
),
shiny::div(
style = "display: inline-block; vertical-align:-50%",
# '-50%' still results in a '+50%' compared to the h3 title!
# '-100%' results in a dropdown widget roughly in line with the title
shinyWidgets::dropdown(
shiny::tags$h4("Group identification suppression"),
"Suppress (return NA 'not available') if numerator 2 or less",
"OR difference between numerator and denominator is less than or equal to 2.",
shiny::br(), shiny::br(),
"This is a simple probability-based disclosure suppression",
"(l-diversity) against homogeneity attack e.g. ALL or NONE (or almost ALL/NONE) of the",
"patients in a sub-group have a specified state.",
shiny::br(), shiny::br(),
"This measure is not explicitly mentioned under the PIP QIM User Guide, but",
"is consistent with avoiding disclosure of information about individual",
"patients.",
shiny::br(), shiny::br(),
status = "primary",
size = "xs",
width = "600px",
icon = icon("question-circle"),
animate = shinyWidgets::animateOptions(
enter = shinyWidgets::animations$fading_entrances$fadeIn,
exit = shinyWidgets::animations$fading_exits$fadeOut
),
tooltip = shinyWidgets::tooltipOptions(
placement = "top",
title = "Server description details"
)
)
)
),
easyClose = FALSE,
footer = shiny::tagList(
shiny::modalButton("Cancel"),
shiny::actionButton(inputId = ns("json_ok"), "Save JSON")
)
))
}
})
# if 'Save JSON' button clicked in write JSON modal dialog
# then create JSON string and output to file
shiny::observeEvent(
input$json_ok,
ignoreInit = TRUE, ignoreNULL = TRUE, {
datapath <- shinyFiles::parseSavePath(volumes, input$json_filename) %>>%
dplyr::pull(datapath)
json_string <- writeReportJSON(
d = report_values(),
date_to = input$json_DateTo,
author_id = input$json_author_id,
practice_id = input$json_practice_id,
small_cell_suppression = input$json_small_cell_suppression,
group_identification_suppression = input$json_group_identification_suppression,
)
write(json_string, file = datapath)
shiny::removeModal()
}
)
# standard QIM report is generated from
# 3 services within a 24-month period
#
# warn if non-standard contact period is being chosen
duration_warning <- shiny::reactiveVal(FALSE)
shiny::observeEvent(
c(input$report_duration_n, input$report_duration_unit),
ignoreInit = TRUE, {
if ((input$report_duration_n != 24 ||
input$report_duration_unit != "Months") &&
!duration_warning()) {
shinytoastr::toastr_warning(
message = paste(
"'Standard' QIM report contact duration is 24 months"
),
position = "bottom-center",
closeButton = TRUE,
timeOut = 0
)
duration_warning(TRUE)
}
}
)
# warn if non-standard 'contact' type and number being chosen
contact_type_warning <- shiny::reactiveVal(FALSE)
contact_appointment_warning <- shiny::reactiveVal(FALSE)
contact_visits_warning <- shiny::reactiveVal(FALSE)
shiny::observeEvent(
c(input$report_contact_type, input$report_min_contact),
ignoreInit = TRUE, ignoreNULL = FALSE, {
if ((input$report_contact_type != "Services" ||
input$report_min_contact != 3) &&
!contact_type_warning()) {
shinytoastr::toastr_warning(
message = paste(
"'Standard' QIM report contact type is minimum",
"of three (3) services."
),
position = "bottom-center",
closeButton = TRUE,
timeOut = 20000
)
contact_type_warning(TRUE)
}
if ("Appointments" %in% input$report_contact_type &&
!contact_appointment_warning()) {
shinytoastr::toastr_warning(
message = paste(
"Choose valid appointment 'status' from the right sidebar.",
"e.g. Invoiced, Waiting, Booked..."
),
position = "bottom-center",
closeButton = TRUE,
timeOut = 20000
)
contact_appointment_warning(TRUE)
}
if ("Visits" %in% input$report_contact_type &&
!contact_visits_warning()) {
shinytoastr::toastr_warning(
message = paste(
"Choose valid visit 'types' from the right sidebar.",
"e.g. Surgery, Telephone, Telhealth, SMS, Email..."
),
position = "bottom-center",
closeButton = TRUE,
timeOut = 20000
)
contact_visits_warning(TRUE)
}
}
)
# warn if more than one report being generated
# could take a long time!
n_report_warning <- shiny::reactiveVal(FALSE)
shiny::observeEvent(
input$report_number,
ignoreInit = TRUE, {
if (input$report_number != 1 &&
!n_report_warning()) {
shinytoastr::toastr_warning(
message = paste(
"Each report could take a long time",
"to create!"
),
position = "bottom-center",
closeButton = TRUE,
timeOut = 10000
)
n_report_warning(TRUE)
}
}
)
# if report
shiny::observeEvent(
report$report_values(),
ignoreInit = TRUE, ignoreNULL = TRUE, {
shiny::req(report$report_values())
if (nrow(report$report_values()) > 0) {
report_values(
report$report_values() %>>%
dplyr::mutate(DateTo = as.character(DateTo))
# co-erce to character (instead of numeric)
)
# copy the dataframe
shinytoastr::toastr_info(
"Copying report to Report Creator, can be saved as JSON",
closeButton = TRUE,
position = "bottom-left", title = "PIP report"
)
}
}
)
return(list(report_values = reactive({report_values()})))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.