", names(dd$data)[i], " - ", dd$standard[[i]]$standard, "
") # If partial data spec match - give the fraction of variables matched } else { - fraction_cols <- paste0(toString(length(dd$standard[[i]]$details[[temp_standard]]$matched_columns)), "/" , - toString(length(dd$standard[[i]]$details[[temp_standard]]$missing_columns) + - length(dd$standard[[i]]$details[[temp_standard]]$matched_columns))) + valid_count <- dd$standard[[i]]$details[[temp_standard]]$valid_count + total_count <- dd$standard[[i]]$details[[temp_standard]]$invalid_count + valid_count + + fraction_cols <- paste0(valid_count, "/" ,total_count) + names(choices)[i] <- paste0("", names(dd$data)[i], " - ", "Partial ", - dd$standard[[i]]$standard, " (", fraction_cols, " columns)", "
") + dd$standard[[i]]$standard, " (", fraction_cols, " data settings)", "") } } return(choices) @@ -129,9 +131,12 @@ dataUpload <- function(input, output, session){ partial <- ifelse(standard()$details[[current_standard]]$match == "Partial", TRUE, FALSE) if (partial) { - partial_cols <- standard()$details[[current_standard]]$matched_columns + partial_keys <- standard()$details[[current_standard]]$checks %>% + filter(valid==TRUE) %>% + select(text_key) %>% + pull() - generateSettings(standard=current_standard, chart="eDish", partial=partial, partial_cols = partial_cols) + generateSettings(standard=current_standard, chart="eDish", partial=partial, partial_keys = partial_keys) } else { generateSettings(standard=current_standard, chart="eDish") diff --git a/inst/eDISH_app/modules/renderSettings/renderSettings.R b/inst/eDISH_app/modules/renderSettings/renderSettings.R index af6d96c9..3c6aa6d9 100644 --- a/inst/eDISH_app/modules/renderSettings/renderSettings.R +++ b/inst/eDISH_app/modules/renderSettings/renderSettings.R @@ -22,10 +22,26 @@ renderSettings <- function(input, output, session, data, settings, status){ choices_tb <- unique(c(settings$measure_values$TB, as.character(data()[,settings$measure_col]))) choices_alp <- unique(c(settings$measure_values$ALP, as.character(data()[,settings$measure_col]))) - updateSelectizeInput(session, "measure_values--ALT", choices = choices_alt) - updateSelectizeInput(session, "measure_values--AST", choices = choices_ast) - updateSelectizeInput(session, "measure_values--TB", choices = choices_tb) - updateSelectizeInput(session, "measure_values--ALP", choices = choices_alp) + updateSelectizeInput(session, "measure_values--ALT", choices = choices_alt, + options = list (onInitialize = I('function() { + //console.log("initializing input with value") + //console.log(this) + }'))) + updateSelectizeInput(session, "measure_values--AST", choices = choices_ast, + options = list (onInitialize = I('function() { + //console.log("initializing input with value") + //console.log(this) + }'))) + updateSelectizeInput(session, "measure_values--TB", choices = choices_tb, + options = list (onInitialize = I('function() { + //console.log("initializing input with value") + //console.log(this) + }'))) + updateSelectizeInput(session, "measure_values--ALP", choices = choices_alp, + options = list (onInitialize = I('function() { + //console.log("initializing input with value") + //console.log(this) + }'))) } else { choices_ast <- unique(data()[,input$measure_col]) choices_alt <- unique(data()[,input$measure_col]) @@ -34,20 +50,32 @@ renderSettings <- function(input, output, session, data, settings, status){ updateSelectizeInput(session, "measure_values--ALT", choices = choices_alt, options = list( - placeholder = '', - onInitialize = I('function() { this.setValue(""); }'))) + onInitialize = I('function() { + //console.log("initializing input w/o value") + //console.log(this) + this.setValue(""); + }'))) updateSelectizeInput(session, "measure_values--AST", choices = choices_ast, options = list( - placeholder = '', - onInitialize = I('function() { this.setValue(""); }'))) + onInitialize = I('function() { + //console.log("initializing input w/o value") + //console.log(this) + this.setValue(""); + }'))) updateSelectizeInput(session, "measure_values--TB", choices = choices_tb, options = list( - placeholder = '', - onInitialize = I('function() { this.setValue(""); }'))) + onInitialize = I('function() { + //console.log("initializing input w/o value") + //console.log(this) + this.setValue(""); + }'))) updateSelectizeInput(session, "measure_values--ALP", choices = choices_alp, options = list( - placeholder = '', - onInitialize = I('function() { this.setValue(""); }'))) + onInitialize = I('function() { + //console.log("initializing input w/o value") + //console.log(this) + this.setValue(""); + }'))) } } else { updateSelectizeInput(session, "measure_values--ALT", choices = "") @@ -71,15 +99,22 @@ renderSettings <- function(input, output, session, data, settings, status){ choices <- unique(c(settings$baseline$values, as.character(data()[,settings$baseline$value_col]))) choices <- sort(choices) - updateSelectizeInput(session, "baseline--values", choices = choices) + updateSelectizeInput(session, "baseline--values", choices = choices, + options = list (onInitialize = I('function() { + //console.log("initializing input with value") + //console.log(this) + }'))) } else { choices <- unique(data()[,input$`baseline--value_col`]) choices <- sort(choices) updateSelectizeInput(session, "baseline--values", choices = choices, options = list( - placeholder = '', - onInitialize = I('function() { this.setValue(""); }'))) + onInitialize = I('function() { + //console.log("initializing input w/o value") + //console.log(this) + this.setValue(""); + }'))) } } else { updateSelectizeInput(session, "baseline--values", choices = "") @@ -99,14 +134,21 @@ renderSettings <- function(input, output, session, data, settings, status){ if (!is.null(settings$analysisFlag$value_col) && input$`analysisFlag--value_col`==settings$analysisFlag$value_col){ choices <- unique(c(settings$analysisFlag$values, as.character(data()[,settings$analysisFlag$value_col]))) - updateSelectizeInput(session, "analysisFlag--values", choices = choices) + updateSelectizeInput(session, "analysisFlag--values", choices = choices,, + options = list (onInitialize = I('function() { + //console.log("initializing input with value") + //console.log(this) + }'))) } else { choices <- unique(data()[,input$`analysisFlag--value_col`]) updateSelectizeInput(session, "analysisFlag--values", choices = choices, options = list( - placeholder = '', - onInitialize = I('function() { this.setValue(""); }'))) + onInitialize = I('function() { + //console.log("initializing input w/o value") + //console.log(this) + this.setValue(""); + }'))) } } else { updateSelectizeInput(session, "analysisFlag--values", choices = "") @@ -222,10 +264,8 @@ renderSettings <- function(input, output, session, data, settings, status){ #Setting Status information (from failed checks only) status_df <- reactive({ req(status_new()) - status_new()$checkList %>% - map(., ~ keep(., names(.) %in% c("text_key","valid","message")) %>% - data.frame(., stringsAsFactors = FALSE)) %>% - bind_rows %>% + + status_new()$checks %>% group_by(text_key) %>% mutate(num_fail = sum(valid==FALSE)) %>% mutate(message_long = paste(message, collapse = " ") %>% trimws(), @@ -336,7 +376,6 @@ renderSettings <- function(input, output, session, data, settings, status){ } }) - ### return updated settings and status to global env. return(list(settings = reactive(settings_new()), status = reactive(status_new()))) diff --git a/inst/eDISH_app/modules/renderSettings/renderSettingsUI.R b/inst/eDISH_app/modules/renderSettings/renderSettingsUI.R index caeea3c5..0738d245 100644 --- a/inst/eDISH_app/modules/renderSettings/renderSettingsUI.R +++ b/inst/eDISH_app/modules/renderSettings/renderSettingsUI.R @@ -4,207 +4,227 @@ renderSettingsUI <- function(id){ ns <- NS(id) tagList( - fluidRow( - splitLayout( - tagList( - wellPanel( - fluidRow( - column(6, - h3("Data Mapping"), - div( - span(id = ns("tt_lbl_id_col"), title = "", - tags$label(id = ns("lbl_id_col"), "")), - span(id = ns("tt_msg_id_col"), title = "", - tags$label(id = ns("msg_id_col"), "")), - selectizeInput(ns("id_col"),NULL, choices = NULL) - - ), - - div( - span(id = ns("tt_lbl_value_col"), title = "", - tags$label(id = ns("lbl_value_col"), "")), - span(id = ns("tt_msg_value_col"), title = "", - tags$label(id = ns("msg_value_col"), "")), - selectizeInput(ns("value_col"),NULL, choices = NULL) - - ), - - div( - span(id = ns("tt_lbl_measure_col"), title = "", - tags$label(id = ns("lbl_measure_col"), "")), - span(id = ns("tt_msg_measure_col"), title = "", - tags$label(id = ns("msg_measure_col"), "")), - selectizeInput(ns("measure_col"),NULL, choices = NULL) - ), - div( - span(id = ns("tt_lbl_measure_values--ALT"), title = "", - tags$label(id = ns("lbl_measure_values--ALT"), "")), - span(id = ns("tt_msg_measure_values--ALT"), title = "", - tags$label(id = ns("msg_measure_values--ALT"), "")), - selectizeInput(ns("measure_values--ALT"),NULL, choices = NULL) - ), - div( - span(id = ns("tt_lbl_measure_values--AST"), title = "", - tags$label(id = ns("lbl_measure_values--AST"), "")), - span(id = ns("tt_msg_measure_values--AST"), title = "", - tags$label(id = ns("msg_measure_values--AST"), "")), - selectizeInput(ns("measure_values--AST"),NULL, choices = NULL) - ), - div( - span(id = ns("tt_lbl_measure_values--TB"), title = "", - tags$label(id = ns("lbl_measure_values--TB"), "")), - span(id = ns("tt_msg_measure_values--TB"), title = "", - tags$label(id = ns("msg_measure_values--TB"), "")), - selectizeInput(ns("measure_values--TB"),NULL, choices = NULL) - ), - div( - span(id = ns("tt_lbl_measure_values--ALP"), title = "", - tags$label(id = ns("lbl_measure_values--ALP"), "")), - span(id = ns("tt_msg_measure_values--ALP"), title = "", - tags$label(id = ns("msg_measure_values--ALP"), "")), - selectizeInput(ns("measure_values--ALP"),NULL, choices = NULL) - ), - div( - span(id = ns("tt_lbl_normal_col_low"), title = "", - tags$label(id = ns("lbl_normal_col_low"), "")), - span(id = ns("tt_msg_normal_col_low"), title = "", - tags$label(id = ns("msg_normal_col_low"), "")), - selectizeInput(ns("normal_col_low"),NULL, choices = NULL) - ), - div( - span(id = ns("tt_lbl_normal_col_high"), title = "", - tags$label(id = ns("lbl_normal_col_high"), "")), - span(id = ns("tt_msg_normal_col_high"), title = "", - tags$label(id = ns("msg_normal_col_high"), "")), - selectizeInput(ns("normal_col_high"),NULL, choices = NULL) - ) - ) , - column(6, - br(), - br(), - br(), - div( - span(id = ns("tt_lbl_visit_col"), title = "", - tags$label(id = ns("lbl_visit_col"), "")), - span(id = ns("tt_msg_visit_col"), title = "", - tags$label(id = ns("msg_visit_col"), "")), - selectizeInput(ns("visit_col"),NULL, choices = NULL) - ), - div( - span(id = ns("tt_lbl_visitn_col"), title = "", - tags$label(id = ns("lbl_visitn_col"), "")), - span(id = ns("tt_msg_visitn_col"), title = "", - tags$label(id = ns("msg_visitn_col"), "")), - selectizeInput(ns("visitn_col"),NULL, choices = NULL) - ), - div( - span(id = ns("tt_lbl_studyday_col"), title = "", - tags$label(id = ns("lbl_studyday_col"), "")), - span(id = ns("tt_msg_studyday_col"), title = "", - tags$label(id = ns("msg_studyday_col"), "")), - selectizeInput(ns("studyday_col"),NULL, choices = NULL) - ), - div( - span(id = ns("tt_lbl_baseline--value_col"), title = "", - tags$label(id = ns("lbl_baseline--value_col"), "")), - span(id = ns("tt_msg_baseline--value_col"), title = "", - tags$label(id = ns("msg_baseline--value_col"), "")), - selectizeInput(ns("baseline--value_col"),NULL, choices = NULL) - ), - div( - span(id = ns("tt_lbl_baseline--values"), title = "", - tags$label(id = ns("lbl_baseline--values"), "")), - span(id = ns("tt_msg_baseline--values"), title = "", - tags$label(id = ns("msg_baseline--values"), "")), - selectizeInput(ns("baseline--values"),NULL, choices = NULL, multiple = TRUE) - ), - div( - span(id = ns("tt_lbl_filters"), title = "", - tags$label(id = ns("lbl_filters"), "")), - span(id = ns("tt_msg_filters"), title = "", - tags$label(id = ns("msg_filters"), "")), - selectInput(ns("filters"),NULL, choices = NULL, selected = NULL, multiple = TRUE) - ), - div( - span(id = ns("tt_lbl_group_cols"), title = "", - tags$label(id = ns("lbl_group_cols"), "")), - span(id = ns("tt_msg_group_cols"), title = "", - tags$label(id = ns("msg_group_cols"), "")), - selectInput(ns("group_cols"),NULL, choices = NULL, selected = NULL, multiple = TRUE) - ), - div( - span(id = ns("tt_lbl_analysisFlag--value_col"), title = "", - tags$label(id = ns("lbl_analysisFlag--value_col"), "")), - span(id = ns("tt_msg_analysisFlag--value_col"), title = "", - tags$label(id = ns("msg_analysisFlag--value_col"), "")), - selectizeInput(ns("analysisFlag--value_col"),NULL, choices = NULL) - ), - div( - span(id = ns("tt_lbl_analysisFlag--values"), title = "", - tags$label(id = ns("lbl_analysisFlag--values"), "")), - span(id = ns("tt_msg_analysisFlag--values"), title = "", - tags$label(id = ns("msg_analysisFlag--values"), "")), - selectizeInput(ns("analysisFlag--values"),NULL, choices = NULL, multiple = TRUE) - ), - br(), - br(), - br(), - br(), - br() - )) - ) - ), - tagList( - column(6, - wellPanel( - h3("Measure Settings"), - div( - div(id = ns("tt_lbl_x_options"), title = "", - tags$label(id = ns("lbl_x_options"), "")), - selectizeInput(ns("x_options"),NULL, choices = c("ALT", "AST", "ALP","TB"), selected = c("ALT", "AST", "ALP"), multiple=TRUE) - ), - div( - div(id = ns("tt_lbl_y_options"), title = "", - tags$label(id = ns("lbl_y_options"), "")), - selectizeInput(ns("y_options"),NULL, choices = c("ALT", "AST", "ALP","TB"), selected = c("TB"), multiple = TRUE) - ) - - ), - wellPanel( - h3("Appearance Settings"), - div( - div(id = ns("tt_lbl_visit_window"), title = "", - tags$label(id = ns("lbl_visit_window"), "")), - sliderInput(ns("visit_window"),NULL, value = 30, min=0, max=50) - ), - div( - div(id = ns("tt_lbl_r_ratio_filter"), title = "", - tags$label(id = ns("lbl_r_ratio_filter"), "")), - checkboxInput(ns("r_ratio_filter"),NULL, value = TRUE) - ), - conditionalPanel( - condition="input.r_ratio_filter==true", ns=ns, - div( - div(id = ns("tt_lbl_r_ratio_cut"), title = "", - tags$label(id = ns("lbl_r_ratio_cut"), "")), - sliderInput(ns("r_ratio_cut"),NULL, value = 0, min=0, max =1) - ) - ), - div( - div(id = ns("tt_lbl_showTitle"), title = "", - tags$label(id = ns("lbl_showTitle"), "")), - checkboxInput(ns("showTitle"),NULL, value = TRUE) - ), - div( - div(id = ns("tt_lbl_warningText"), title = "", - tags$label(id = ns("lbl_warningText"), "")), - textAreaInput (ns("warningText"),NULL, rows =4, - value = "Caution: This interactive graphic is not validated. Any clinical recommendations based on this tool should be confirmed using your organizations standard operating procedures.") - ) - ) - ) - )) - ) - - ) + verticalLayout( + + fluidRow( + column(6, + div( + div(style="display: inline-block;", h3("Data Mapping")), + div(style="display: inline-block;", checkboxInput(ns("show_data_mapping"), "show", TRUE)) + ) + ) + ), + conditionalPanel(condition="input.show_data_mapping", ns=ns, + fluidRow( + column(4, + wellPanel( + div( + span(id = ns("tt_lbl_id_col"), title = "", + tags$label(id = ns("lbl_id_col"), "")), + span(id = ns("tt_msg_id_col"), title = "", + tags$label(id = ns("msg_id_col"), "")), + selectizeInput(ns("id_col"),NULL, choices = NULL) + + ), + + div( + span(id = ns("tt_lbl_value_col"), title = "", + tags$label(id = ns("lbl_value_col"), "")), + span(id = ns("tt_msg_value_col"), title = "", + tags$label(id = ns("msg_value_col"), "")), + selectizeInput(ns("value_col"),NULL, choices = NULL) + + ), + + div( + span(id = ns("tt_lbl_measure_col"), title = "", + tags$label(id = ns("lbl_measure_col"), "")), + span(id = ns("tt_msg_measure_col"), title = "", + tags$label(id = ns("msg_measure_col"), "")), + selectizeInput(ns("measure_col"),NULL, choices = NULL) + ), + div( + span(id = ns("tt_lbl_measure_values--ALT"), title = "", + tags$label(id = ns("lbl_measure_values--ALT"), "")), + span(id = ns("tt_msg_measure_values--ALT"), title = "", + tags$label(id = ns("msg_measure_values--ALT"), "")), + selectizeInput(ns("measure_values--ALT"),NULL, choices = NULL) + ), + div( + span(id = ns("tt_lbl_measure_values--AST"), title = "", + tags$label(id = ns("lbl_measure_values--AST"), "")), + span(id = ns("tt_msg_measure_values--AST"), title = "", + tags$label(id = ns("msg_measure_values--AST"), "")), + selectizeInput(ns("measure_values--AST"),NULL, choices = NULL) + ), + div( + span(id = ns("tt_lbl_measure_values--TB"), title = "", + tags$label(id = ns("lbl_measure_values--TB"), "")), + span(id = ns("tt_msg_measure_values--TB"), title = "", + tags$label(id = ns("msg_measure_values--TB"), "")), + selectizeInput(ns("measure_values--TB"),NULL, choices = NULL) + ), + div( + span(id = ns("tt_lbl_measure_values--ALP"), title = "", + tags$label(id = ns("lbl_measure_values--ALP"), "")), + span(id = ns("tt_msg_measure_values--ALP"), title = "", + tags$label(id = ns("msg_measure_values--ALP"), "")), + selectizeInput(ns("measure_values--ALP"),NULL, choices = NULL) + ), + # ), + div( + span(id = ns("tt_lbl_normal_col_low"), title = "", + tags$label(id = ns("lbl_normal_col_low"), "")), + span(id = ns("tt_msg_normal_col_low"), title = "", + tags$label(id = ns("msg_normal_col_low"), "")), + selectizeInput(ns("normal_col_low"),NULL, choices = NULL) + ), + div( + span(id = ns("tt_lbl_normal_col_high"), title = "", + tags$label(id = ns("lbl_normal_col_high"), "")), + span(id = ns("tt_msg_normal_col_high"), title = "", + tags$label(id = ns("msg_normal_col_high"), "")), + selectizeInput(ns("normal_col_high"),NULL, choices = NULL) + ), + div( + span(id = ns("tt_lbl_visit_col"), title = "", + tags$label(id = ns("lbl_visit_col"), "")), + span(id = ns("tt_msg_visit_col"), title = "", + tags$label(id = ns("msg_visit_col"), "")), + selectizeInput(ns("visit_col"),NULL, choices = NULL) + ), + div( + span(id = ns("tt_lbl_visitn_col"), title = "", + tags$label(id = ns("lbl_visitn_col"), "")), + span(id = ns("tt_msg_visitn_col"), title = "", + tags$label(id = ns("msg_visitn_col"), "")), + selectizeInput(ns("visitn_col"),NULL, choices = NULL) + ), + div( + span(id = ns("tt_lbl_studyday_col"), title = "", + tags$label(id = ns("lbl_studyday_col"), "")), + span(id = ns("tt_msg_studyday_col"), title = "", + tags$label(id = ns("msg_studyday_col"), "")), + selectizeInput(ns("studyday_col"),NULL, choices = NULL) + ), + div( + span(id = ns("tt_lbl_baseline--value_col"), title = "", + tags$label(id = ns("lbl_baseline--value_col"), "")), + span(id = ns("tt_msg_baseline--value_col"), title = "", + tags$label(id = ns("msg_baseline--value_col"), "")), + selectizeInput(ns("baseline--value_col"),NULL, choices = NULL) + ), + div( + span(id = ns("tt_lbl_baseline--values"), title = "", + tags$label(id = ns("lbl_baseline--values"), "")), + span(id = ns("tt_msg_baseline--values"), title = "", + tags$label(id = ns("msg_baseline--values"), "")), + selectizeInput(ns("baseline--values"),NULL, choices = NULL, multiple = TRUE) + ), + div( + span(id = ns("tt_lbl_filters"), title = "", + tags$label(id = ns("lbl_filters"), "")), + span(id = ns("tt_msg_filters"), title = "", + tags$label(id = ns("msg_filters"), "")), + selectInput(ns("filters"),NULL, choices = NULL, selected = NULL, multiple = TRUE) + ), + div( + span(id = ns("tt_lbl_group_cols"), title = "", + tags$label(id = ns("lbl_group_cols"), "")), + span(id = ns("tt_msg_group_cols"), title = "", + tags$label(id = ns("msg_group_cols"), "")), + selectInput(ns("group_cols"),NULL, choices = NULL, selected = NULL, multiple = TRUE) + ), + div( + span(id = ns("tt_lbl_analysisFlag--value_col"), title = "", + tags$label(id = ns("lbl_analysisFlag--value_col"), "")), + span(id = ns("tt_msg_analysisFlag--value_col"), title = "", + tags$label(id = ns("msg_analysisFlag--value_col"), "")), + selectizeInput(ns("analysisFlag--value_col"),NULL, choices = NULL) + ), + div( + span(id = ns("tt_lbl_analysisFlag--values"), title = "", + tags$label(id = ns("lbl_analysisFlag--values"), "")), + span(id = ns("tt_msg_analysisFlag--values"), title = "", + tags$label(id = ns("msg_analysisFlag--values"), "")), + selectizeInput(ns("analysisFlag--values"),NULL, choices = NULL, multiple = TRUE) + ) + )) + + ) + ), + + fluidRow( + column(6, + div( + div(style="display: inline-block;", h3("Measure Settings")), + div(style="display: inline-block;", checkboxInput(ns("show_measure_settings"), "show", TRUE)) + ) + ) + ), + conditionalPanel(condition="input.show_measure_settings", ns=ns, + fluidRow( + column(4, + wellPanel( + div( + div(id = ns("tt_lbl_x_options"), title = "", + tags$label(id = ns("lbl_x_options"), "")), + selectizeInput(ns("x_options"),NULL, choices = c("ALT", "AST", "ALP","TB"), selected = c("ALT", "AST", "ALP"), multiple=TRUE) + ), + div( + div(id = ns("tt_lbl_y_options"), title = "", + tags$label(id = ns("lbl_y_options"), "")), + selectizeInput(ns("y_options"),NULL, choices = c("ALT", "AST", "ALP","TB"), selected = c("TB"), multiple = TRUE) + ) + + ) + ) + ) + ), + fluidRow( + column(6, + div( + div(style="display: inline-block;", h3("Appearance Settings")), + div(style="display: inline-block;", checkboxInput(ns("show_appearance_settings"), "show", TRUE)) + ) + ) + ), + conditionalPanel(condition="input.show_appearance_settings", ns=ns, + fluidRow( + column(4, + wellPanel( + div( + div(id = ns("tt_lbl_visit_window"), title = "", + tags$label(id = ns("lbl_visit_window"), "")), + sliderInput(ns("visit_window"),NULL, value = 30, min=0, max=50) + ), + div( + div(id = ns("tt_lbl_r_ratio_filter"), title = "", + tags$label(id = ns("lbl_r_ratio_filter"), "")), + checkboxInput(ns("r_ratio_filter"),NULL, value = TRUE) + ), + conditionalPanel( + condition="input.r_ratio_filter==true", ns=ns, + div( + div(id = ns("tt_lbl_r_ratio_cut"), title = "", + tags$label(id = ns("lbl_r_ratio_cut"), "")), + sliderInput(ns("r_ratio_cut"),NULL, value = 0, min=0, max =1) + ) + ), + div( + div(id = ns("tt_lbl_showTitle"), title = "", + tags$label(id = ns("lbl_showTitle"), "")), + checkboxInput(ns("showTitle"),NULL, value = TRUE) + ), + div( + div(id = ns("tt_lbl_warningText"), title = "", + tags$label(id = ns("lbl_warningText"), "")), + textAreaInput (ns("warningText"),NULL, rows =4, + value = "Caution: This interactive graphic is not validated. Any clinical recommendations based on this tool should be confirmed using your organizations standard operating procedures.") + ) + ) + ) + ) + ) + )) } diff --git a/inst/eDISH_app/modules/renderSettings/util/flagSetting.R b/inst/eDISH_app/modules/renderSettings/util/flagSetting.R index e09ce26c..eb0b6542 100644 --- a/inst/eDISH_app/modules/renderSettings/util/flagSetting.R +++ b/inst/eDISH_app/modules/renderSettings/util/flagSetting.R @@ -1,4 +1,7 @@ flagSetting<-function(session, name, originalLabel){ + + originalLabel <- paste("", originalLabel) + shinyjs::html(id = paste0("lbl_", name), html = paste0(originalLabel, "*"), add = FALSE) diff --git a/inst/eDISH_app/modules/renderSettings/util/labelSetting.R b/inst/eDISH_app/modules/renderSettings/util/labelSetting.R index 013d9e1a..cf0f4cf7 100644 --- a/inst/eDISH_app/modules/renderSettings/util/labelSetting.R +++ b/inst/eDISH_app/modules/renderSettings/util/labelSetting.R @@ -1,4 +1,7 @@ labelSetting<-function(ns, name, label, description){ + + + label <- paste("", label) label_id <- paste0("lbl_", name) shinyjs::html(id = label_id, diff --git a/inst/eDISH_app/modules/renderSettings/util/updateSettingStatus.R b/inst/eDISH_app/modules/renderSettings/util/updateSettingStatus.R index 761acd4a..c594d42b 100644 --- a/inst/eDISH_app/modules/renderSettings/util/updateSettingStatus.R +++ b/inst/eDISH_app/modules/renderSettings/util/updateSettingStatus.R @@ -5,13 +5,15 @@ updateSettingStatus<-function(ns, name, status_short, status_long){ if (status_short=="OK"){ shinyjs::html(id = msg_id, - html = paste0(" ", status_short,"")) + html = paste(" ", status_short,"", + "")) shinyjs::runjs(paste0('$("#',ns(tooltip_id), '").attr("title", "Selection is valid")')) } else { shinyjs::html(id = msg_id, - html = paste0(" ", status_short,"")) + html = paste(" ", status_short,"", + "")) shinyjs::runjs(paste0('$("#',ns(tooltip_id), '").attr("title", "', status_long, '")')) }