Merge pull request #16 from openpharma/dev_improve_queries

improve queries
openpharma · May 29, 2024 · 48e4a7d · 48e4a7d
2 parents f29a720 + 815bbe5
commit 48e4a7d
Show file tree

Hide file tree

Showing 33 changed files with 8,711 additions and 139 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -26,8 +26,8 @@ export(custom_plot_theme)
 export(datatable_custom)
 export(date_cols_to_char)
 export(db_create)
-export(db_get_latest_query)
-export(db_get_latest_review)
+export(db_get_query)
+export(db_get_review)
 export(db_save)
 export(db_save_review)
 export(db_slice_rows)

diff --git a/R/fct_SQLite.R b/R/fct_SQLite.R
@@ -150,7 +150,7 @@ db_update <- function(
     latest_review_data = data, #get_review_data(merge_meta_with_data(data), common_vars), 
     common_vars = common_vars,
     edit_time_var = edit_time_var
-    )
+  )
   cat("writing updated review data to database...\n")
   DBI::dbWriteTable(con, "all_review_data", updated_review_data, append = TRUE)
   cat("Finished updating review data\n")
@@ -205,12 +205,12 @@ db_save_review <- function(
     dplyr::collect()
   if(nrow(new_review_rows) == 0){return(
     warning("Review state unaltered. No review will be saved.")
-    )}
+  )}
   new_review_rows <- new_review_rows |> 
     db_slice_rows(slice_vars = c("timestamp", "edit_date_time"), group_vars = common_vars) |> 
     dplyr::select(-dplyr::all_of(cols_to_change)) |> 
     # If there are multiple edits, make sure to only select the latest editdatetime for all items:
-   # dplyr::slice_max(edit_date_time, by = dplyr::all_of(common_vars)) |> 
+    # dplyr::slice_max(edit_date_time, by = dplyr::all_of(common_vars)) |> 
     dplyr::bind_cols(rv_row[cols_to_change]) # bind_cols does not work in a db connection.
   cat("write updated review data to database\n")
   lapply(tables, \(x){DBI::dbWriteTable(db_con, x, new_review_rows, append = TRUE)}) |> 
@@ -243,63 +243,73 @@ db_save <- function(data, db_path, db_table = "query_data"){
 }
 
 
-#' Retrieve latest query
+#'Retrieve query from database
 #'
-#' Small helper function to retrieve the latest query with the provided query_id
-#' and query follow-up number (n)
+#'Small helper function to retrieve a query from the database. if no follow-up
+#'number is provided, all messages will be collected.
 #'
-#' @param db_path Character vector. Needs to be a valid path to a database.
-#' @param query_id Character string with the query identifier to extract from
-#'   the database.
-#' @param n Numerical or character string, with the query follow-up number to
-#'   extract
-#' @param db_table Character vector with the name of the table to read from.
+#'@param db_path Character vector. Needs to be a valid path to a database.
+#'@param query_id Character string with the query identifier to extract from the
+#'  database.
+#'@param n (optional) numerical or character string, with the query follow-up
+#'  number to extract
+#'@param db_table Character vector with the name of the table to read from.
 #'
-#' @return A data frame 
-#' @export
-#' @inheritParams db_slice_rows
+#'@return A data frame
+#'@export
+#'@inheritParams db_slice_rows
 #'
-#' @examples 
+#' @examples
 #'local({
-#' temp_path <- withr::local_tempfile(fileext = ".sqlite") 
+#' temp_path <- withr::local_tempfile(fileext = ".sqlite")
 #' con <- get_db_connection(temp_path)
-#' 
+#'
 #' new_query <- dplyr::tibble(
-#'  query_id = "ID124234", 
+#'  query_id = "ID124234",
 #'  subject_id = "ID1",
 #'  n = 1,
 #'  timestamp = "2024-02-05 01:01:01",
 #'  other_info = "testinfo"
-#' ) 
+#' )
 #' DBI::dbWriteTable(con, "query_data", new_query)
-#' db_get_latest_query(temp_path, query_id = "ID124234", n = 1)
+#' db_get_query(temp_path, query_id = "ID124234", n = 1)
 #' })
 #' 
-db_get_latest_query <- function(
+db_get_query <- function(
     db_path, 
-    query_id = new_query$query_id, 
-    n = new_query$n,
+    query_id, 
+    n = NULL,
     db_table = "query_data",
     slice_vars = "timestamp",
     group_vars = c("query_id", "n")
-    ){
+){
   stopifnot(file.exists(db_path))
   stopifnot(is.character(query_id))
   stopifnot(is.character(db_table))
-  stopifnot(is.numeric(n) | is.character(n))
+  stopifnot(is.null(n) | is.numeric(n) | is.character(n))
+  filter_n <- ifelse(is.null(n), "", " AND n=?n")
+  sql <- paste0(
+    "SELECT * FROM ?db_table WHERE query_id = ?query_id", 
+    filter_n, ";"
+  )
   db_temp_connect(db_path, {
-    sql <- "SELECT * FROM ?db_table WHERE query_id = ?query_id AND n = ?n;"
-    query <- DBI::sqlInterpolate(con, sql, db_table = db_table[1], 
-                                 query_id = query_id[1], n = n[1])
+    sql_args <- list(
+      conn = con, 
+      sql = sql, 
+      db_table = db_table[1], 
+      query_id = query_id[1]
+    )
+    sql_args$n <- n[1] #So that this function argument will be conditional.
+    query <- do.call(DBI::sqlInterpolate, sql_args)
     DBI::dbGetQuery(con, query) |> 
       db_slice_rows(slice_vars = slice_vars, group_vars = group_vars) |> 
       dplyr::as_tibble()
   })
 }
 
-#' Retrieve latest review
+#' Retrieve review
 #'
-#' Small helper function to retrieve the latest review data from the database
+#' Small helper function to retrieve the (latest) review data from the database
 #' with the given subject id (`subject`) and `form`.
 #'
 #' @param db_path Character vector. Needs to be a valid path to a database.
@@ -328,24 +338,25 @@ db_get_latest_query <- function(
 #'   ) |>
 #'    dplyr::as_tibble()
 #'   DBI::dbWriteTable(con, "all_review_data", review_data)
-#'   db_get_latest_review(temp_path, subject = "Test_name", form = "Test_group")
+#'   db_get_review(temp_path, subject = "Test_name", form = "Test_group")
 #' })
 #' 
-db_get_latest_review <- function(
+db_get_review <- function(
     db_path, 
     subject = review_row$subject_id, 
     form = review_row$item_group,
     db_table = "all_review_data",
     slice_vars = c("timestamp", "edit_date_time"),
     group_vars = c("subject_id", "event_name", "item_group",
                    "form_repeat", "item_name")
-    ){
+){
   stopifnot(file.exists(db_path))
   stopifnot(is.character(subject))
   stopifnot(is.character(form))
   db_temp_connect(db_path, {
     sql <- "SELECT * FROM ?db_table WHERE subject_id = ?id AND item_group = ?group;"
-    query <- DBI::sqlInterpolate(con, sql, db_table = db_table[1], id = subject[1], group = form[1])
+    query <- DBI::sqlInterpolate(con, sql, db_table = db_table[1], 
+                                 id = subject[1], group = form[1])
     DBI::dbGetQuery(con, query) |> 
       db_slice_rows(slice_vars = slice_vars, group_vars = group_vars) |> 
       dplyr::as_tibble()

diff --git a/R/global.R b/R/global.R
@@ -83,6 +83,7 @@ utils::globalVariables(
     "out_of_lim",
     "n",
     "query",
+    "type",
     "resolved",
     "reviewer",
     "CTCAE severity worsening",

diff --git a/R/mod_queries.R b/R/mod_queries.R
@@ -10,6 +10,15 @@ mod_queries_ui <- function(id){
     bslib::layout_columns(
       col_widths = c(8,4),
       bslib::card(
+        bslib::card_body(
+          shinyWidgets::materialSwitch(
+            inputId = ns("show_resolved"),
+            label = "Show resolved queries", 
+            status = "primary",
+            right = TRUE
+          ),
+          fill = FALSE
+        ),
         bslib::card_body(
           shinycssloaders::withSpinner(
             DT::DTOutput(ns("queries")),
@@ -76,6 +85,7 @@ mod_queries_server <- function(id, r, navinfo, all_forms, db_path, table_names){
     selected_query <- reactive({
       req(nrow(initial_queries())>0)
       req(input$queries_rows_selected)
+      req(input$queries_rows_selected <= nrow(initial_queries()))
       with(initial_queries(), query_id[input$queries_rows_selected])
     })
 
@@ -90,12 +100,18 @@ mod_queries_server <- function(id, r, navinfo, all_forms, db_path, table_names){
                                selected_query = selected_query, db_path = db_path)
 
     initial_queries <- reactive({
-      df <- r$query_data |> 
-        dplyr::filter(n == 1) 
+      df <- with(r$query_data, r$query_data[n == 1, ] )
       if(nrow(df) == 0) return(df) 
-      df |>
+      df <- df |>
         dplyr::slice_min(timestamp, by = c(subject_id, event_label, query_id)) |>
-        dplyr::arrange(.data[["resolved"]])
+        dplyr::arrange(.data[["resolved"]], .data[["type"]])
+
+      if(input$show_resolved) return(df)
+      with(df, df[resolved == "No", ] )
+    })
+
+    observeEvent(input$queries_rows_selected, {
+      input$queries_rows_selected
     })
 
     mod_go_to_form_server(
@@ -111,11 +127,18 @@ mod_queries_server <- function(id, r, navinfo, all_forms, db_path, table_names){
 
     output[["queries"]] <- DT::renderDT({
       req(initial_queries())
+      query_cols <- c("subject_id", "type", "event_label", 
+                      "item_group", "query", "timestamp")
+      table_title <- "Open queries"
+      if(input$show_resolved){
+        query_cols <- c("resolved", query_cols)
+        table_title <- "All queries"
+      }
       datatable_custom(
-        initial_queries()[c("subject_id", "event_label", "item_group", "timestamp", "query", "resolved")], 
+        initial_queries()[query_cols], 
         table_names, 
-        title = "All queries"
-        )
+        title = table_title
+      )
     })
 
     output[["selected_query_title"]] <- renderText({
@@ -138,7 +161,7 @@ mod_queries_server <- function(id, r, navinfo, all_forms, db_path, table_names){
     output[["selected_query"]] <- DT::renderDT({
       req(selected_query_data())
       datatable_custom(
-        selected_query_data()[c("reviewer", "timestamp", "query")], 
+        selected_query_data()[c("query", "reviewer", "timestamp")], 
         table_names, 
         options = list(dom = 't', ordering = FALSE, pageLength = 100, scrollY = "200px"),
         class = "row-border hover",

diff --git a/R/mod_query_add.R b/R/mod_query_add.R
@@ -73,7 +73,7 @@ mod_query_add_server <- function(
         bslib::card(
           bslib::layout_sidebar(
             sidebar = bslib::sidebar(
-              id = ns("query.sidebar"),
+              id = ns("query_sidebar"),
               open = "always",
               HTML(paste0("<b>", unique(sel_data$item_group), "</b>")),
               shiny::selectizeInput(
@@ -105,9 +105,28 @@ mod_query_add_server <- function(
                 width = "100%",
                 placeholder = "add query text here"
               ),
+              bslib::card_body(
+                shinyWidgets::materialSwitch(
+                  inputId = ns("query_major"),
+                  label = "Major query", 
+                  status = "danger",
+                  inline = TRUE, 
+                  right = TRUE
+                ),
+                bslib::popover(
+                  icon("circle-info"),
+                  title = "Major queries",
+                  id = ns("query_major_info"),
+                  markdown("Only use for issues that could have a major impact 
+                  on either the patient safety or the study outcomes.")
+                ), 
+                class = "d-flex flex-row", 
+                fillable = FALSE,
+                gap = 0
+              ),
               verbatimTextOutput(ns("reviewer"))
             ),
-            shiny::verbatimTextOutput(ns("query_error"))
+            verbatimTextOutput(ns("query_error"))
           ),
           min_height = "500px"
         ),
@@ -140,7 +159,8 @@ mod_query_add_server <- function(
       golem::cat_dev("Query text to add: ", input$query_text, "\n")
       new_query <- dplyr::tibble(
         "query_id"      = paste0(r$subject_id, create_unique_id(5)), 
-        "subject_id"     = r$subject_id,
+        "type"          = ifelse(input$query_major, "Major", "Normal"),
+        "subject_id"    = r$subject_id,
         "event_label"   = input$query_select_visit, 
         "item_group"    = active_form(), 
         "item"          = input$query_select_item, 
@@ -155,7 +175,7 @@ mod_query_add_server <- function(
       golem::print_dev(new_query)
 
       db_save(data = new_query, db_path = db_path, db_table = "query_data")
-      query_in_db <- db_get_latest_query(
+      query_in_db <- db_get_query(
         db_path, query_id = new_query$query_id, n = new_query$n
       )
       query_in_db <- unique(query_in_db[names(new_query)])
@@ -217,12 +237,12 @@ mod_query_add_server <- function(
       cat("Author:", r$user_name(), "\n")
     })
 
-
+    
   })
 }
-    
+
 ## To be copied in the UI
 # mod_write_queries_ui("write_queries_1")
-    
+
 ## To be copied in the server
 # mod_write_queries_server("write_queries_1")
diff --git a/R/mod_query_follow_up.R b/R/mod_query_follow_up.R
@@ -47,6 +47,25 @@ mod_query_follow_up_server <- function(id, r, selected_query, db_path){
   moduleServer( id, function(input, output, session){
     ns <- session$ns
 
+    observeEvent(selected_query(), {
+      is_resolved <- any(
+        with(r$query_data, resolved[query_id == selected_query()]) == "Yes" 
+      )
+      shiny::updateCheckboxInput(inputId = "resolved", value = is_resolved)
+      shiny::updateTextAreaInput(
+        inputId = "query_follow_up_text", 
+        placeholder = ifelse(
+          is_resolved, 
+          "query is resolved", 
+          "add response here"
+        )
+      )
+      if(is_resolved){
+        shinyjs::disable("query_follow_up") 
+      } else{
+        shinyjs::enable("query_follow_up") 
+      }
+    })
     query_save_error <- reactiveVal(FALSE)
     observeEvent(input$query_add_follow_up, {
       req(input$query_follow_up_text, r$user_name(), selected_query())
@@ -55,11 +74,9 @@ mod_query_follow_up_server <- function(id, r, selected_query, db_path){
       golem::cat_dev("Query FU text to add: ", input$query_follow_up_text, "\n")
       ts <- time_stamp()
 
-      updated_query <- r$query_data |> 
-        dplyr::as_tibble() |> 
-        dplyr::filter(query_id == selected_query()) |>
-        dplyr::distinct(query_id, subject_id, item_group, item, event_label, n) |> 
-        dplyr::slice_max(n, with_ties = FALSE)
+      updated_query <- db_get_query(db_path, selected_query()) |> 
+        db_slice_rows(slice_vars = "timestamp", group_vars = "query_id") |> 
+        dplyr::distinct(query_id, type, subject_id, item_group, item, event_label, n)
       updated_query <- updated_query |> 
         dplyr::mutate(
           "timestamp"     = ts, 
@@ -75,7 +92,7 @@ mod_query_follow_up_server <- function(id, r, selected_query, db_path){
       # Update queries and selected queries data:
       db_save(data = updated_query, db_path = db_path, db_table = "query_data")
       #verify if query update was successful:
-      query_in_db <- db_get_latest_query(
+      query_in_db <- db_get_query(
         db_path, query_id = updated_query$query_id, n = updated_query$n
       )
       query_in_db <- unique(query_in_db[names(updated_query)])
@@ -96,7 +113,7 @@ mod_query_follow_up_server <- function(id, r, selected_query, db_path){
         !identical(updated_query, query_in_db),
         !identical(query_in_db, query_in_memory)
       ))
-
+      
       if(query_save_error()){
         return({
           showNotification(
@@ -111,7 +128,7 @@ mod_query_follow_up_server <- function(id, r, selected_query, db_path){
           r$query_data <- collect_query_data(db_path)
         })
       }
-
+      
       updateTextInput(inputId = "query_follow_up_text", value = "")
 
       shiny::updateCheckboxInput(