Diff: devex vs dev

DESCRIPTION

@@ -1,6 +1,7 @@
 Package: clinsight
 Title: ClinSight
 Version: 0.1.1.9011
+DevexVersion: 9001
 Authors@R: c(
     person("Leonard Daniël", "Samson", , "[email protected]", role = c("cre", "aut"),
            comment = c(ORCID = "0000-0002-6252-7639")),

NEWS.md

@@ -9,12 +9,16 @@
 - Added form type as a class to be used in `create_table()` to display tables.
 - Add a logging table to the DB for reviews.
 - Simplify pulling data from DB for reviews.
-- Review data by records IDs instead of subject & form
 
 ## Bug fixes
 
 - The test-coverage GHA workflow is updated so that codecov uploads work again.
 
+## `devex` changes
+- Added `Excel` download button to Queries table & patient listings that need review.
+- Added helper function to automatically determine when adding said excel button is appropriate.
+- Review data by records IDs instead of subject & form
+
 # clinsight 0.1.1
 
 ## Changed 

R/app_server.R

@@ -30,6 +30,9 @@ app_server <- function(
     })
   check_appdata(app_data, meta)
 
+  session$userData$review_records <- reactiveValues()
+  session$userData$update_checkboxes <- reactiveValues()
+
   res_auth <- authenticate_server(
     all_sites = app_vars$Sites$site_code, 
     credentials_db = credentials_db,

R/fct_data_helpers.R

@@ -505,6 +505,35 @@ add_missing_columns <- function(
   data
 }
 
+#' Configure DT helper
+#'
+#' Small wrapper that helps handle some messiness preparing the correct `DT`
+#' dom, extensions, & options when needed. Specifically, when & how to add an
+#' Excel download button.
+#'
+#' @param data A data frame used for display in a DT table. Number of rows will
+#'   be assessed
+#' @param table_name character string, usually the form name
+#'
+#' @keywords internal
+#' @return list with three named objects: `dom`, `exts`, and `opts`
+dt_config <- function(data, table_name = "form") {
+  default_args<- formals(datatable_custom)
+  if(nrow(data) > 0 & isTRUE(get_golem_config("allow_listing_download"))) {
+    dt_dom <- 'Bfti'
+    dt_exts <- c("Buttons", eval(default_args$extensions))
+    dt_opts <- list(buttons=list(list(extend = 'excel',
+        text = '<i class="fa-solid fa-download"></i>',
+        filename = paste("clinsight", gsub(" ", "-", table_name), sep = ".")
+        )))
+  } else {
+    dt_dom <- default_args$dom |> eval()
+    dt_exts <- default_args$extensions |> eval()
+    dt_opts <- default_args$options |> eval()
+  }
+  return(list(dom = dt_dom, exts = dt_exts, opts = dt_opts))
+}
+
 #' Custom interactive datatable
 #'
 #' Small wrapper around [DT::datatable()]. Will be used to create tables in a

R/fct_tables.R

@@ -51,6 +51,17 @@ create_table.default <- function(
   stopifnot(is.character(keep_vars))
   stopifnot(is.character(name_column))
   stopifnot(is.character(value_column))
+  if ("reviewed" %in% names(data)) {
+    data <- dplyr::mutate(
+      data,
+      o_reviewed = dplyr::case_when(
+        any(reviewed == "No") & any(reviewed == "Yes") ~ list(list(reviewed = NA, ids = id)),
+        any(reviewed == "Yes") ~ list(list(reviewed = TRUE, ids = id)),
+        .default = list(list(reviewed = FALSE, ids = id))
+      ),
+      .by = dplyr::all_of(keep_vars))
+    keep_vars <- c("o_reviewed", keep_vars)
+  }
   df <- data[c(keep_vars, name_column, value_column)] |> 
     tidyr::pivot_wider(
       names_from = {{name_column}}, 
@@ -298,6 +309,7 @@ create_table.medication <- function(
     ) |> 
     dplyr::arrange(dplyr::desc(in_use), dplyr::desc(`Start Date`)) |> 
     dplyr::select(
+      dplyr::any_of("o_reviewed"),
       dplyr::all_of(c(keep_vars, "Name")), 
       dplyr::everything(),
       -dplyr::all_of(c("in_use", "Active Ingredient", "Trade Name", 

R/mod_common_forms.R

@@ -94,6 +94,7 @@
     ns <- session$ns
 
     data_active <- reactive({
+      req(!is.null(input$show_all_data))
       shiny::validate(need(
         !is.null(r$filtered_data[[form]]),
         paste0("Warning: no data found in the database for the form '", form, "'.")
@@ -125,15 +126,90 @@
       SAE_data <- data_active() |> 
         dplyr::filter(grepl("Yes", `Serious Adverse Event`)) |> 
         dplyr::select(dplyr::any_of(
-          c("subject_id","form_repeat", "Name", "AESI",  "SAE Start date", 
+          c("o_reviewed", "subject_id","form_repeat", "Name", "AESI",  "SAE Start date", 
             "SAE End date", "CTCAE severity", "Treatment related", 
             "Treatment action", "Other action", "SAE Category", 
             "SAE Awareness date", "SAE Date of death", "SAE Death reason")
         )) |> 
         adjust_colnames("^SAE ")
       if(!input$show_all_data) SAE_data$subject_id <- NULL
-      datatable_custom(SAE_data, rename_vars = table_names, rownames= FALSE,
-                       title = "Serious Adverse Events", escape = FALSE)
+
+      # determine DT dom / exts / opts
+      DT <- dt_config(SAE_data,
+        table_name = paste("SAE", ifelse(input$show_all_data,
+        "all_patients", r$subject_id), sep = ".")) 
+      datatable_custom(
+        SAE_data, 
+        rename_vars = c("Review Status" = "o_reviewed", table_names), 
+        rownames = FALSE,
+        title = "Serious Adverse Events", 
+        escape = FALSE,
+        dom = DT$dom,
+        extensions = DT$exts,
+        selection = "none",
+        callback = checkbox_callback,
+        options = append(list(
+          columnDefs = list(list(
+            targets = 0,
+            render = checkbox_render
+          )),
+          createdRow = checkbox_create_callback
+        ),
+        DT$opts))
+    }, server = FALSE)
+
+    observeEvent(data_active(), {
+      session$userData$update_checkboxes[[form]] <- NULL
+      session$userData$review_records[[form]] <- data.frame(id = integer(), reviewed = character())
+    })
+
+    observeEvent(input$common_form_table_review_selection, {
+      session$userData$update_checkboxes[[form]] <- NULL
+
+      session$userData$review_records[[form]] <-
+        dplyr::rows_upsert(
+          session$userData$review_records[[form]],
+          input$common_form_table_review_selection,
+          by = "id"
+        ) |> 
+        dplyr::filter(!is.na(reviewed)) |> 
+        dplyr::semi_join(
+          subset(r$review_data, subject_id == r$subject_id & item_group == form),
+          by = "id"
+        ) |> 
+        dplyr::anti_join(
+          subset(r$review_data, subject_id == r$subject_id & item_group == form),
+          by = c("id", "reviewed")
+        ) |> 
+        dplyr::arrange(id)
+    })
+
+    observeEvent(session$userData$update_checkboxes[[form]], {
+      checked <- session$userData$update_checkboxes[[form]]
+
+      update_cbs(ns("common_form_table"), checked)
+      update_cbs(ns("SAE_table"), checked)
+    })
+
+    observeEvent(input$SAE_table_review_selection, {
+      session$userData$update_checkboxes[[form]] <- NULL
+
+      session$userData$review_records[[form]] <-
+        dplyr::rows_upsert(
+          session$userData$review_records[[form]],
+          input$SAE_table_review_selection,
+          by = "id"
+        ) |> 
+        dplyr::filter(!is.na(reviewed)) |> 
+        dplyr::semi_join(
+          subset(r$review_data, subject_id == r$subject_id & item_group == form),
+          by = "id"
+        ) |> 
+        dplyr::anti_join(
+          subset(r$review_data, subject_id == r$subject_id & item_group == form),
+          by = c("id", "reviewed")
+        ) |> 
+        dplyr::arrange(id)
     })
 
     output[["common_form_table"]] <- DT::renderDT({
@@ -145,10 +221,31 @@
           dplyr::select(-dplyr::starts_with("SAE"))
       }
       if(!input$show_all_data) df$subject_id <- NULL
-      datatable_custom(df, rename_vars = table_names, rownames= FALSE,
-                       title = form, escape = FALSE)
-    })
-
+
+      # determine DT dom / exts / opts
+      DT <- dt_config(df,
+         table_name = paste(form, ifelse(input$show_all_data,
+         "all_patients", r$subject_id), sep = ".")) 
+      datatable_custom(
+        df, 
+        rename_vars = c("Review Status" = "o_reviewed", table_names), 
+        rownames= FALSE,
+        title = form, 
+        escape = FALSE,
+        dom = DT$dom,
+        extensions = DT$exts,
+        selection = "none",
+        callback = checkbox_callback,
+        options = append(list(
+          columnDefs = list(list(
+            targets = 0,
+            render = checkbox_render
+          )),
+          createdRow = checkbox_create_callback
+        ),
+        DT$opts))
+    }, server = FALSE)
+
   })
 }
 

R/mod_queries.R

@@ -144,11 +144,17 @@ mod_queries_server <- function(id, r, navinfo, all_forms, db_path, table_names){
         query_cols <- c("resolved", query_cols)
         table_title <- "All queries"
       }
+
+      # determine DT dom / exts / opts
+      DT <- dt_config(initial_queries()[query_cols],
+              table_name = paste(ifelse(input$show_resolved, "all", "open"),
+                           "queries", sep = ".")) 
       datatable_custom(
         initial_queries()[query_cols], 
         table_names, 
         title = table_title,
-        callback = dblclick_to_form(ns("go_to_form"))
+        callback = dblclick_to_form(ns("go_to_form")),
+        dom = DT$dom, extensions = DT$exts, options = DT$opts
       )
     })