improved import ui and redcap import with status messages

NAMESPACE

@@ -42,6 +42,7 @@ export(getfun)
 export(gg_theme_export)
 export(gg_theme_shiny)
 export(grepl_fix)
+export(if_not_missing)
 export(import_delim)
 export(import_dta)
 export(import_file_server)

NEWS.md

@@ -1,3 +1,7 @@
+# FreesearchR 25.4.12
+
+Polished and simplified data import module including a much improved REDCap import module.
+
 # FreesearchR 25.4.1
 
 Focus is on polish and improved ui/ux.

R/app_version.R

@@ -1 +1 @@
-app_version <- function()'250403_0630'
+app_version <- function()'Version: 25.4.1.250403_1309'

R/helpers.R

@@ -369,3 +369,26 @@ get_ggplot_label <- function(data,label){
   assertthat::assert_that(ggplot2::is.ggplot(data))
   data$labels[[label]]
 }
+
+
+#' Return if available
+#'
+#' @param data vector
+#' @param default assigned value for missings
+#'
+#' @returns vector
+#' @export
+#'
+#' @examples
+#' NULL |> if_not_missing("new")
+#' c(2,"a",NA) |> if_not_missing()
+#' "See" |> if_not_missing()
+if_not_missing <- function(data,default=NULL){
+  if (length(data)>1){
+    Reduce(c,lapply(data,if_not_missing))
+  } else if (is.na(data) || is.null(data)){
+    return(default)
+  } else {
+    return(data)
+  }
+}

R/redcap_read_shiny_module.R

@@ -7,7 +7,7 @@
 #'
 #' @return shiny ui element
 #' @export
-m_redcap_readUI <- function(id, title = TRUE) {
+m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
   ns <- shiny::NS(id)
 
   if (isTRUE(title)) {
@@ -23,7 +23,7 @@ m_redcap_readUI <- function(id, title = TRUE) {
     shiny::textInput(
       inputId = ns("uri"),
       label = "Web address",
-      value = "https://redcap.your.institution/"
+      value = if_not_missing(url, "https://redcap.your.institution/")
     ),
     shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"),
     shiny::textInput(
@@ -32,11 +32,13 @@ m_redcap_readUI <- function(id, title = TRUE) {
       value = ""
     ),
     shiny::helpText("The token is a string of 32 numbers and letters."),
+    shiny::br(),
+    shiny::br(),
     shiny::actionButton(
       inputId = ns("data_connect"),
       label = "Connect",
       icon = shiny::icon("link", lib = "glyphicon"),
-      # width = NULL,
+      width = "100%",
       disabled = TRUE
     ),
     shiny::br(),
@@ -53,6 +55,15 @@ m_redcap_readUI <- function(id, title = TRUE) {
     shiny::br()
   )
 
+  filter_ui <-
+    shiny::tagList(
+      # width = 6,
+      shiny::uiOutput(outputId = ns("arms")),
+      shiny::textInput(
+        inputId = ns("filter"),
+        label = "Optional filter logic (e.g., ⁠[gender] = 'female')"
+      )
+    )
 
   params_ui <-
     shiny::tagList(
@@ -60,41 +71,28 @@ m_redcap_readUI <- function(id, title = TRUE) {
       shiny::tags$h4("Data import parameters"),
       shiny::helpText("Options here will show, when API and uri are typed"),
       shiny::uiOutput(outputId = ns("fields")),
+      shiny::tags$div(
+        class = "shiny-input-container",
+        shiny::tags$label(
+          class = "control-label",
+          `for` = ns("dropdown_params"),
+          "...",
+          style = htmltools::css(visibility = "hidden")
+        ),
+        shinyWidgets::dropMenu(
+          shiny::actionButton(
+            inputId = ns("dropdown_params"),
+            label = "Add data filters",
+            icon = shiny::icon("filter"),
+            width = "100%",
+            class = "px-1"
+          ),
+          filter_ui
+        ),
+        shiny::helpText("Optionally filter project arms if logitudinal or apply server side data filters")
+      ),
       shiny::uiOutput(outputId = ns("data_type")),
       shiny::uiOutput(outputId = ns("fill")),
-      shinyWidgets::switchInput(
-        inputId = "do_filter",
-        label = "Apply filter?",
-        value = FALSE,
-        inline = FALSE,
-        onLabel = "YES",
-        offLabel = "NO"
-      ),
-      shiny::conditionalPanel(
-        condition = "input.do_filter",
-        shiny::uiOutput(outputId = ns("arms")),
-        shiny::textInput(
-          inputId = ns("filter"),
-          label = "Optional filter logic (e.g., ⁠[gender] = 'female')"
-        )
-      )
-    )
-
-
-  shiny::fluidPage(
-    title=title,
-    bslib::layout_columns(
-      server_ui,
-      params_ui,
-      col_widths = bslib::breakpoints(
-        sm = c(12, 12),
-        md = c(12, 12)
-      )
-    ),
-    shiny::column(
-      width = 12,
-      # shiny::actionButton(inputId = ns("import"), label = "Import"),
-      ## TODO: Use busy indicator like on download to have button activate/deactivate
       shiny::actionButton(
         inputId = ns("data_import"),
         label = "Import",
@@ -102,6 +100,18 @@ m_redcap_readUI <- function(id, title = TRUE) {
         width = "100%",
         disabled = TRUE
       ),
+      shiny::tags$br(),
+      shiny::tags$br(),
+      tags$div(
+        id = ns("retrieved-placeholder"),
+        shinyWidgets::alert(
+          id = ns("retrieved-result"),
+          status = "info",
+          tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.")
+        ),
+        dismissible = TRUE
+      )#,
+      ## TODO: Use busy indicator like on download to have button activate/deactivate
       # bslib::input_task_button(
       #   id = ns("data_import"),
       #   label = "Import",
@@ -114,12 +124,20 @@ m_redcap_readUI <- function(id, title = TRUE) {
       #   type = "primary",
       #   auto_reset = TRUE#,state="busy"
       # ),
-      shiny::br(),
+      # shiny::br(),
-      shiny::br(),
+      # shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding.")
-      shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding."),
-      shiny::br(),
-      shiny::br()
     )
+
+
+  shiny::fluidPage(
+    title = title,
+    server_ui,
+    shiny::conditionalPanel(
+      condition = "output.connect_success == true",
+      params_ui,
+      ns = ns
+    ),
+    shiny::br()
   )
 }
 
@@ -149,8 +167,8 @@ m_redcap_readServer <- function(id) {
     shiny::observeEvent(list(input$api, input$uri), {
       shiny::req(input$api)
       shiny::req(input$uri)
-      if (!is.null(input$uri)){
+      if (!is.null(input$uri)) {
-      uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/")
+        uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/")
       } else {
         uri <- input$uri
       }
@@ -204,9 +222,11 @@ m_redcap_readServer <- function(id) {
               datamods:::insert_alert(
                 selector = ns("connect"),
                 status = "success",
-                include_data_alert(see_data_text = "Click to see data dictionary",
+                include_data_alert(
+                  see_data_text = "Click to see data dictionary",
                   dataIdName = "see_data",
-                  extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), tags$p(paste0(data_rv$info$project_title, " loaded."))),
+                  extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"),
+                                 glue::glue("The {data_rv$info$project_title} project is loaded.")),
                   btn_show_data = TRUE
                 )
               )
@@ -225,6 +245,9 @@ m_redcap_readServer <- function(id) {
       }
     )
 
+    output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
+    shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
+
     shiny::observeEvent(input$see_data, {
       datamods::show_data(
         purrr::pluck(data_rv$dd_list, "data"),
@@ -313,17 +336,21 @@ m_redcap_readServer <- function(id) {
     })
 
     output$arms <- shiny::renderUI({
-      vectorSelectInput(
+      if (NROW(arms()) > 0) {
-        inputId = ns("arms"),
+        vectorSelectInput(
-        selected = NULL,
+          inputId = ns("arms"),
-        label = "Filter by events/arms",
+          selected = NULL,
-        choices = stats::setNames(arms()[[3]], arms()[[1]]),
+          label = "Filter by events/arms",
-        multiple = TRUE
+          choices = stats::setNames(arms()[[3]], arms()[[1]]),
-      )
+          multiple = TRUE
+        )
+      }
     })
 
     shiny::observeEvent(input$data_import, {
       shiny::req(input$fields)
+
+      # browser()
       record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
 
 
@@ -334,7 +361,11 @@ m_redcap_readServer <- function(id) {
         events = input$arms,
         raw_or_label = "both",
         filter_logic = input$filter,
-        split_forms = if (input$data_type == "long") "none" else "all"
+        split_forms = ifelse(
+          input$data_type == "long" && !is.null(input$data_type),
+          "none",
+          "all"
+        )
       )
 
       shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
@@ -342,19 +373,24 @@ m_redcap_readServer <- function(id) {
       })
 
       code <- rlang::call2("read_redcap_tables",
-                           !!!utils::modifyList(parameters,list(token="PERSONAL_API_TOKEN")),
+        !!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), ,
-                           , .ns = "REDCapCAST")
+        .ns = "REDCapCAST"
+      )
 
+      # browser()
 
       if (inherits(imported, "try-error") || NROW(imported) < 1) {
         data_rv$data_status <- "error"
         data_rv$data_list <- NULL
+        data_rv$data_message <- imported$raw_text
       } else {
         data_rv$data_status <- "success"
+        data_rv$data_message <- "Requested data was retrieved!"
 
         ## The data management below should be separated to allow for changing
         ## "wide"/"long" without re-importing data
-        if (input$data_type != "long") {
+
+        if (parameters$split_form == "all") {
           # browser()
           out <- imported |>
             # redcap_wider()
@@ -378,6 +414,20 @@ m_redcap_readServer <- function(id) {
           }
         }
 
+        # browser()
+        in_data_check <- parameters$fields %in% names(out) |
+          sapply(names(out), \(.x) any(sapply(parameters$fields, \(.y) startsWith(.x, .y))))
+
+        if (!any(in_data_check[-1])) {
+          data_rv$data_status <- "warning"
+          data_rv$data_message <- "Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
+        }
+
+        if (!all(in_data_check)) {
+          data_rv$data_status <- "warning"
+          data_rv$data_message <- "Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
+        }
+
         data_rv$code <- code
 
         data_rv$data <- out |>
@@ -387,13 +437,33 @@ m_redcap_readServer <- function(id) {
       }
     })
 
-    # shiny::observe({
+    shiny::observeEvent(
-    #   shiny::req(data_rv$imported)
+      data_rv$data_status,
-    #
+      {
-    #   imported <- data_rv$imported
+        # browser()
-    #
+        if (identical(data_rv$data_status, "error")) {
-    #
+          datamods:::insert_error(mssg = data_rv$data_message, selector = ns("retrieved"))
-    # })
+        } else if (identical(data_rv$data_status, "success")) {
+          datamods:::insert_alert(
+            selector = ns("retrieved"),
+            status = data_rv$data_status,
+            tags$p(
+              tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
+              data_rv$data_message
+            )
+          )
+        } else {
+          datamods:::insert_alert(
+            selector = ns("retrieved"),
+            status = data_rv$data_status,
+            tags$p(
+              tags$b(phosphoricons::ph("warning", weight = "bold"), "Warning!"),
+              data_rv$data_message
+            )
+          )
+        }
+      }
+    )
 
     return(list(
       status = shiny::reactive(data_rv$data_status),
@@ -553,13 +623,12 @@ drop_empty_event <- function(data, event = "redcap_event_name") {
 #' }
 redcap_demo_app <- function() {
   ui <- shiny::fluidPage(
-    m_redcap_readUI("data"),
+    m_redcap_readUI("data", url = NULL),
     DT::DTOutput("data"),
     shiny::tags$b("Code:"),
     shiny::verbatimTextOutput(outputId = "code")
   )
   server <- function(input, output, session) {
-
     data_val <- m_redcap_readServer(id = "data")
 
     output$data <- DT::renderDataTable(

R/regression_plot.R

@@ -2,12 +2,14 @@
 #'
 #' @param x (`tbl_regression`, `tbl_uvregression`)\cr
 #'   A 'tbl_regression' or 'tbl_uvregression' object
-##  #' @param remove_header_rows (scalar `logical`)\cr
+#' @param plot_ref (scalar `logical`)\cr
-##  #'   logical indicating whether to remove header rows
+#'   plot reference values
-##  #'   for categorical variables. Default is `TRUE`
+#' @param remove_header_rows (scalar `logical`)\cr
-##  #' @param remove_reference_rows (scalar `logical`)\cr
+#'   logical indicating whether to remove header rows
-##  #'   logical indicating whether to remove reference rows
+#'   for categorical variables. Default is `TRUE`
-##  #'   for categorical variables. Default is `FALSE`.
+#' @param remove_reference_rows (scalar `logical`)\cr
+#'   logical indicating whether to remove reference rows
+#'   for categorical variables. Default is `FALSE`.
 #' @param ... arguments passed to `ggstats::ggcoef_plot(...)`
 #'
 #' @returns ggplot object

R/update-variables-ext.R

@@ -645,10 +645,10 @@ convert_to <- function(data,
       setNames(list(expr(as.character(!!sym(variable)))), variable)
     )
   } else if (identical(new_class, "factor")) {
-    data[[variable]] <- as.factor(x = data[[variable]])
+    data[[variable]] <- REDCapCAST::as_factor(x = data[[variable]])
     attr(data, "code_03_convert") <- c(
       attr(data, "code_03_convert"),
-      setNames(list(expr(as.factor(!!sym(variable)))), variable)
+      setNames(list(expr(REDCapCAST::as_factor(!!sym(variable)))), variable)
     )
   } else if (identical(new_class, "numeric")) {
     data[[variable]] <- as.numeric(data[[variable]], ...)

inst/apps/FreesearchR/app.R

@@ -10,7 +10,7 @@
 #### Current file: /Users/au301842/FreesearchR/R//app_version.R 
 ########
 
-app_version <- function()'250403_0630'
+app_version <- function()'Version: 25.4.1.250403_1309'
 
 
 ########
@@ -2844,6 +2844,29 @@ get_ggplot_label <- function(data,label){
 }
 
 
+#' Return if available
+#'
+#' @param data vector
+#' @param default assigned value for missings
+#'
+#' @returns vector
+#' @export
+#'
+#' @examples
+#' NULL |> if_not_missing("new")
+#' c(2,"a",NA) |> if_not_missing()
+#' "See" |> if_not_missing()
+if_not_missing <- function(data,default=NULL){
+  if (length(data)>1){
+    Reduce(c,lapply(data,if_not_missing))
+  } else if (is.na(data) || is.null(data)){
+    return(default)
+  } else {
+    return(data)
+  }
+}
+
+
 ########
 #### Current file: /Users/au301842/FreesearchR/R//import-file-ext.R 
 ########
@@ -4168,7 +4191,7 @@ plot_download_server <- function(id,
 #'
 #' @return shiny ui element
 #' @export
-m_redcap_readUI <- function(id, title = TRUE) {
+m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
   ns <- shiny::NS(id)
 
   if (isTRUE(title)) {
@@ -4184,7 +4207,7 @@ m_redcap_readUI <- function(id, title = TRUE) {
     shiny::textInput(
       inputId = ns("uri"),
       label = "Web address",
-      value = "https://redcap.your.institution/"
+      value = if_not_missing(url, "https://redcap.your.institution/")
     ),
     shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"),
     shiny::textInput(
@@ -4193,11 +4216,13 @@ m_redcap_readUI <- function(id, title = TRUE) {
       value = ""
     ),
     shiny::helpText("The token is a string of 32 numbers and letters."),
+    shiny::br(),
+    shiny::br(),
     shiny::actionButton(
       inputId = ns("data_connect"),
       label = "Connect",
       icon = shiny::icon("link", lib = "glyphicon"),
-      # width = NULL,
+      width = "100%",
       disabled = TRUE
     ),
     shiny::br(),
@@ -4214,6 +4239,15 @@ m_redcap_readUI <- function(id, title = TRUE) {
     shiny::br()
   )
 
+  filter_ui <-
+    shiny::tagList(
+      # width = 6,
+      shiny::uiOutput(outputId = ns("arms")),
+      shiny::textInput(
+        inputId = ns("filter"),
+        label = "Optional filter logic (e.g., ⁠[gender] = 'female')"
+      )
+    )
 
   params_ui <-
     shiny::tagList(
@@ -4221,41 +4255,28 @@ m_redcap_readUI <- function(id, title = TRUE) {
       shiny::tags$h4("Data import parameters"),
       shiny::helpText("Options here will show, when API and uri are typed"),
       shiny::uiOutput(outputId = ns("fields")),
+      shiny::tags$div(
+        class = "shiny-input-container",
+        shiny::tags$label(
+          class = "control-label",
+          `for` = ns("dropdown_params"),
+          "...",
+          style = htmltools::css(visibility = "hidden")
+        ),
+        shinyWidgets::dropMenu(
+          shiny::actionButton(
+            inputId = ns("dropdown_params"),
+            label = "Add data filters",
+            icon = shiny::icon("filter"),
+            width = "100%",
+            class = "px-1"
+          ),
+          filter_ui
+        ),
+        shiny::helpText("Optionally filter project arms if logitudinal or apply server side data filters")
+      ),
       shiny::uiOutput(outputId = ns("data_type")),
       shiny::uiOutput(outputId = ns("fill")),
-      shinyWidgets::switchInput(
-        inputId = "do_filter",
-        label = "Apply filter?",
-        value = FALSE,
-        inline = FALSE,
-        onLabel = "YES",
-        offLabel = "NO"
-      ),
-      shiny::conditionalPanel(
-        condition = "input.do_filter",
-        shiny::uiOutput(outputId = ns("arms")),
-        shiny::textInput(
-          inputId = ns("filter"),
-          label = "Optional filter logic (e.g., ⁠[gender] = 'female')"
-        )
-      )
-    )
-
-
-  shiny::fluidPage(
-    title=title,
-    bslib::layout_columns(
-      server_ui,
-      params_ui,
-      col_widths = bslib::breakpoints(
-        sm = c(12, 12),
-        md = c(12, 12)
-      )
-    ),
-    shiny::column(
-      width = 12,
-      # shiny::actionButton(inputId = ns("import"), label = "Import"),
-      ## TODO: Use busy indicator like on download to have button activate/deactivate
       shiny::actionButton(
         inputId = ns("data_import"),
         label = "Import",
@@ -4263,6 +4284,18 @@ m_redcap_readUI <- function(id, title = TRUE) {
         width = "100%",
         disabled = TRUE
       ),
+      shiny::tags$br(),
+      shiny::tags$br(),
+      tags$div(
+        id = ns("retrieved-placeholder"),
+        shinyWidgets::alert(
+          id = ns("retrieved-result"),
+          status = "info",
+          tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.")
+        ),
+        dismissible = TRUE
+      )#,
+      ## TODO: Use busy indicator like on download to have button activate/deactivate
       # bslib::input_task_button(
       #   id = ns("data_import"),
       #   label = "Import",
@@ -4275,12 +4308,20 @@ m_redcap_readUI <- function(id, title = TRUE) {
       #   type = "primary",
       #   auto_reset = TRUE#,state="busy"
       # ),
-      shiny::br(),
+      # shiny::br(),
-      shiny::br(),
+      # shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding.")
-      shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding."),
-      shiny::br(),
-      shiny::br()
     )
+
+
+  shiny::fluidPage(
+    title = title,
+    server_ui,
+    shiny::conditionalPanel(
+      condition = "output.connect_success == true",
+      params_ui,
+      ns = ns
+    ),
+    shiny::br()
   )
 }
 
@@ -4310,8 +4351,8 @@ m_redcap_readServer <- function(id) {
     shiny::observeEvent(list(input$api, input$uri), {
       shiny::req(input$api)
       shiny::req(input$uri)
-      if (!is.null(input$uri)){
+      if (!is.null(input$uri)) {
-      uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/")
+        uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/")
       } else {
         uri <- input$uri
       }
@@ -4365,9 +4406,11 @@ m_redcap_readServer <- function(id) {
               datamods:::insert_alert(
                 selector = ns("connect"),
                 status = "success",
-                include_data_alert(see_data_text = "Click to see data dictionary",
+                include_data_alert(
+                  see_data_text = "Click to see data dictionary",
                   dataIdName = "see_data",
-                  extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), tags$p(paste0(data_rv$info$project_title, " loaded."))),
+                  extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"),
+                                 glue::glue("The {data_rv$info$project_title} project is loaded.")),
                   btn_show_data = TRUE
                 )
               )
@@ -4386,6 +4429,9 @@ m_redcap_readServer <- function(id) {
       }
     )
 
+    output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
+    shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
+
     shiny::observeEvent(input$see_data, {
       datamods::show_data(
         purrr::pluck(data_rv$dd_list, "data"),
@@ -4474,17 +4520,21 @@ m_redcap_readServer <- function(id) {
     })
 
     output$arms <- shiny::renderUI({
-      vectorSelectInput(
+      if (NROW(arms()) > 0) {
-        inputId = ns("arms"),
+        vectorSelectInput(
-        selected = NULL,
+          inputId = ns("arms"),
-        label = "Filter by events/arms",
+          selected = NULL,
-        choices = stats::setNames(arms()[[3]], arms()[[1]]),
+          label = "Filter by events/arms",
-        multiple = TRUE
+          choices = stats::setNames(arms()[[3]], arms()[[1]]),
-      )
+          multiple = TRUE
+        )
+      }
     })
 
     shiny::observeEvent(input$data_import, {
       shiny::req(input$fields)
+
+      # browser()
       record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
 
 
@@ -4495,7 +4545,11 @@ m_redcap_readServer <- function(id) {
         events = input$arms,
         raw_or_label = "both",
         filter_logic = input$filter,
-        split_forms = if (input$data_type == "long") "none" else "all"
+        split_forms = ifelse(
+          input$data_type == "long" && !is.null(input$data_type),
+          "none",
+          "all"
+        )
       )
 
       shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
@@ -4503,19 +4557,24 @@ m_redcap_readServer <- function(id) {
       })
 
       code <- rlang::call2("read_redcap_tables",
-                           !!!utils::modifyList(parameters,list(token="PERSONAL_API_TOKEN")),
+        !!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), ,
-                           , .ns = "REDCapCAST")
+        .ns = "REDCapCAST"
+      )
 
+      # browser()
 
       if (inherits(imported, "try-error") || NROW(imported) < 1) {
         data_rv$data_status <- "error"
         data_rv$data_list <- NULL
+        data_rv$data_message <- imported$raw_text
       } else {
         data_rv$data_status <- "success"
+        data_rv$data_message <- "Requested data was retrieved!"
 
         ## The data management below should be separated to allow for changing
         ## "wide"/"long" without re-importing data
-        if (input$data_type != "long") {
+
+        if (parameters$split_form == "all") {
           # browser()
           out <- imported |>
             # redcap_wider()
@@ -4539,6 +4598,20 @@ m_redcap_readServer <- function(id) {
           }
         }
 
+        # browser()
+        in_data_check <- parameters$fields %in% names(out) |
+          sapply(names(out), \(.x) any(sapply(parameters$fields, \(.y) startsWith(.x, .y))))
+
+        if (!any(in_data_check[-1])) {
+          data_rv$data_status <- "warning"
+          data_rv$data_message <- "Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
+        }
+
+        if (!all(in_data_check)) {
+          data_rv$data_status <- "warning"
+          data_rv$data_message <- "Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
+        }
+
         data_rv$code <- code
 
         data_rv$data <- out |>
@@ -4548,13 +4621,33 @@ m_redcap_readServer <- function(id) {
       }
     })
 
-    # shiny::observe({
+    shiny::observeEvent(
-    #   shiny::req(data_rv$imported)
+      data_rv$data_status,
-    #
+      {
-    #   imported <- data_rv$imported
+        # browser()
-    #
+        if (identical(data_rv$data_status, "error")) {
-    #
+          datamods:::insert_error(mssg = data_rv$data_message, selector = ns("retrieved"))
-    # })
+        } else if (identical(data_rv$data_status, "success")) {
+          datamods:::insert_alert(
+            selector = ns("retrieved"),
+            status = data_rv$data_status,
+            tags$p(
+              tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
+              data_rv$data_message
+            )
+          )
+        } else {
+          datamods:::insert_alert(
+            selector = ns("retrieved"),
+            status = data_rv$data_status,
+            tags$p(
+              tags$b(phosphoricons::ph("warning", weight = "bold"), "Warning!"),
+              data_rv$data_message
+            )
+          )
+        }
+      }
+    )
 
     return(list(
       status = shiny::reactive(data_rv$data_status),
@@ -4714,13 +4807,12 @@ drop_empty_event <- function(data, event = "redcap_event_name") {
 #' }
 redcap_demo_app <- function() {
   ui <- shiny::fluidPage(
-    m_redcap_readUI("data"),
+    m_redcap_readUI("data", url = NULL),
     DT::DTOutput("data"),
     shiny::tags$b("Code:"),
     shiny::verbatimTextOutput(outputId = "code")
   )
   server <- function(input, output, session) {
-
     data_val <- m_redcap_readServer(id = "data")
 
     output$data <- DT::renderDataTable(
@@ -5422,12 +5514,14 @@ regression_model_uv_list <- function(data,
 #'
 #' @param x (`tbl_regression`, `tbl_uvregression`)\cr
 #'   A 'tbl_regression' or 'tbl_uvregression' object
-##  #' @param remove_header_rows (scalar `logical`)\cr
+#' @param plot_ref (scalar `logical`)\cr
-##  #'   logical indicating whether to remove header rows
+#'   plot reference values
-##  #'   for categorical variables. Default is `TRUE`
+#' @param remove_header_rows (scalar `logical`)\cr
-##  #' @param remove_reference_rows (scalar `logical`)\cr
+#'   logical indicating whether to remove header rows
-##  #'   logical indicating whether to remove reference rows
+#'   for categorical variables. Default is `TRUE`
-##  #'   for categorical variables. Default is `FALSE`.
+#' @param remove_reference_rows (scalar `logical`)\cr
+#'   logical indicating whether to remove reference rows
+#'   for categorical variables. Default is `FALSE`.
 #' @param ... arguments passed to `ggstats::ggcoef_plot(...)`
 #'
 #' @returns ggplot object
@@ -7438,10 +7532,10 @@ convert_to <- function(data,
       setNames(list(expr(as.character(!!sym(variable)))), variable)
     )
   } else if (identical(new_class, "factor")) {
-    data[[variable]] <- as.factor(x = data[[variable]])
+    data[[variable]] <- REDCapCAST::as_factor(x = data[[variable]])
     attr(data, "code_03_convert") <- c(
       attr(data, "code_03_convert"),
-      setNames(list(expr(as.factor(!!sym(variable)))), variable)
+      setNames(list(expr(REDCapCAST::as_factor(!!sym(variable)))), variable)
     )
   } else if (identical(new_class, "numeric")) {
     data[[variable]] <- as.numeric(data[[variable]], ...)
@@ -7840,6 +7934,8 @@ ui_elements <- list(
           condition = "input.source=='redcap'",
           DT::DTOutput(outputId = "redcap_prev")
         ),
+        shiny::conditionalPanel(
+          condition = "output.data_loaded == true",
         shiny::br(),
         shiny::br(),
         shiny::h5("Specify variables to include"),
@@ -7856,7 +7952,7 @@ ui_elements <- list(
             shinyWidgets::noUiSliderInput(
               inputId = "complete_cutoff",
               label = NULL,
-              update_on = "change",
+              update_on = "end",
               min = 0,
               max = 100,
               step = 5,
@@ -7864,12 +7960,13 @@ ui_elements <- list(
               format = shinyWidgets::wNumbFormat(decimals = 0),
               color = datamods:::get_primary_color()
             ),
-            shiny::helpText("Filter variables with completeness above the specified percentage."),
+            shiny::helpText("Exclude variables with completeness below the specified percentage."),
             shiny::br(),
             shiny::br(),
             shiny::uiOutput(outputId = "import_var"),
             shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
           )
+        )
         ),
         shiny::br(),
         shiny::br(),
@@ -8568,19 +8665,34 @@ server <- function(input, output, session) {
     )
   })
 
+  output$data_loaded <- shiny::reactive({
+    !is.null(rv$data_temp)
+    })
+
+  shiny::observeEvent(input$source,{
+    rv$data_temp <- NULL
+    })
+
+  shiny::outputOptions(output, "data_loaded", suspendWhenHidden = FALSE)
 
   shiny::observeEvent(
     eventExpr = list(
       input$import_var,
-      input$complete_cutoff
+      input$complete_cutoff,
+      rv$data_temp
     ),
     handlerExpr = {
       shiny::req(rv$data_temp)
       # browser()
-      rv$data_original <- rv$data_temp |>
+      temp_data <- rv$data_temp
-        dplyr::select(input$import_var) |>
+      if (all(input$import_var %in% names(temp_data))){
+        temp_data <- temp_data |> dplyr::select(input$import_var)
+      }
+
+      rv$data_original <- temp_data |>
         default_parsing()
 
+
       rv$code$import <- rv$code$import |>
         deparse() |>
         paste(collapse = "") |>
@@ -8593,7 +8705,7 @@ server <- function(input, output, session) {
 
       rv$code$filter <- NULL
       rv$code$modify <- NULL
-    }
+    },ignoreNULL = FALSE
   )
 
   output$data_info_import <- shiny::renderUI({
@@ -8618,8 +8730,7 @@ server <- function(input, output, session) {
 
   shiny::observeEvent(
     eventExpr = list(
-      rv$data_original,
+      rv$data_original
-      input$complete_cutoff
     ),
     handlerExpr = {
       shiny::req(rv$data_original)

inst/apps/FreesearchR/server.R

@@ -158,19 +158,34 @@ server <- function(input, output, session) {
     )
   })
 
+  output$data_loaded <- shiny::reactive({
+    !is.null(rv$data_temp)
+    })
+
+  shiny::observeEvent(input$source,{
+    rv$data_temp <- NULL
+    })
+
+  shiny::outputOptions(output, "data_loaded", suspendWhenHidden = FALSE)
 
   shiny::observeEvent(
     eventExpr = list(
       input$import_var,
-      input$complete_cutoff
+      input$complete_cutoff,
+      rv$data_temp
     ),
     handlerExpr = {
       shiny::req(rv$data_temp)
       # browser()
-      rv$data_original <- rv$data_temp |>
+      temp_data <- rv$data_temp
-        dplyr::select(input$import_var) |>
+      if (all(input$import_var %in% names(temp_data))){
+        temp_data <- temp_data |> dplyr::select(input$import_var)
+      }
+
+      rv$data_original <- temp_data |>
         default_parsing()
 
+
       rv$code$import <- rv$code$import |>
         deparse() |>
         paste(collapse = "") |>
@@ -183,7 +198,7 @@ server <- function(input, output, session) {
 
       rv$code$filter <- NULL
       rv$code$modify <- NULL
-    }
+    },ignoreNULL = FALSE
   )
 
   output$data_info_import <- shiny::renderUI({
@@ -208,8 +223,7 @@ server <- function(input, output, session) {
 
   shiny::observeEvent(
     eventExpr = list(
-      rv$data_original,
+      rv$data_original
-      input$complete_cutoff
     ),
     handlerExpr = {
       shiny::req(rv$data_original)

inst/apps/FreesearchR/ui.R

@@ -68,6 +68,8 @@ ui_elements <- list(
           condition = "input.source=='redcap'",
           DT::DTOutput(outputId = "redcap_prev")
         ),
+        shiny::conditionalPanel(
+          condition = "output.data_loaded == true",
         shiny::br(),
         shiny::br(),
         shiny::h5("Specify variables to include"),
@@ -84,7 +86,7 @@ ui_elements <- list(
             shinyWidgets::noUiSliderInput(
               inputId = "complete_cutoff",
               label = NULL,
-              update_on = "change",
+              update_on = "end",
               min = 0,
               max = 100,
               step = 5,
@@ -92,12 +94,13 @@ ui_elements <- list(
               format = shinyWidgets::wNumbFormat(decimals = 0),
               color = datamods:::get_primary_color()
             ),
-            shiny::helpText("Filter variables with completeness above the specified percentage."),
+            shiny::helpText("Exclude variables with completeness below the specified percentage."),
             shiny::br(),
             shiny::br(),
             shiny::uiOutput(outputId = "import_var"),
             shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
           )
+        )
         ),
         shiny::br(),
         shiny::br(),

man/if_not_missing.Rd

@@ -0,0 +1,24 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/helpers.R
+\name{if_not_missing}
+\alias{if_not_missing}
+\title{Return if available}
+\usage{
+if_not_missing(data, default = NULL)
+}
+\arguments{
+\item{data}{vector}
+
+\item{default}{assigned value for missings}
+}
+\value{
+vector
+}
+\description{
+Return if available
+}
+\examples{
+NULL |> if_not_missing("new")
+c(2,"a",NA) |> if_not_missing()
+"See" |> if_not_missing()
+}

man/plot.tbl_regression.Rd

@@ -16,6 +16,17 @@
 \item{x}{(\code{tbl_regression}, \code{tbl_uvregression})\cr
 A 'tbl_regression' or 'tbl_uvregression' object}
 
+\item{plot_ref}{(scalar \code{logical})\cr
+plot reference values}
+
+\item{remove_header_rows}{(scalar \code{logical})\cr
+logical indicating whether to remove header rows
+for categorical variables. Default is \code{TRUE}}
+
+\item{remove_reference_rows}{(scalar \code{logical})\cr
+logical indicating whether to remove reference rows
+for categorical variables. Default is \code{FALSE}.}
+
 \item{...}{arguments passed to \code{ggstats::ggcoef_plot(...)}}
 }
 \value{

man/redcap_read_shiny_module.Rd

@@ -6,7 +6,7 @@
 \alias{redcap_demo_app}
 \title{Shiny module to browser and export REDCap data}
 \usage{
-m_redcap_readUI(id, title = TRUE)
+m_redcap_readUI(id, title = TRUE, url = NULL)
 
 m_redcap_readServer(id)