Merge pull request #703 from SafetyGraphics/fix-701

basic profile integration

Author: samussiah

DESCRIPTION

@@ -21,6 +21,7 @@ Suggests:
     ggplot2 (>= 3.3.0),
     knitr (>= 1.34),
     rmarkdown (>= 2.10),
+    safetyProfile, 
     shinydashboard (>= 0.7.1),
     shinytest (>= 1.5.0),
     testthat (>= 3.0.4),

NAMESPACE

@@ -33,6 +33,8 @@ export(mappingSelectUI)
 export(mappingTab)
 export(mappingTabUI)
 export(prepareChart)
+export(profileTab)
+export(profileTabUI)
 export(safetyGraphicsApp)
 export(safetyGraphicsInit)
 export(safetyGraphicsServer)

R/mod_profileTab.R

@@ -0,0 +1,60 @@
+#' @title UI for the profile module in safetyProfile::profile_ui
+#'
+#' @param id module id
+#' 
+#' @export
+
+profileTabUI <- function(id){  
+    ns <- NS(id)
+    
+    if(isNamespaceLoaded("safetyProfile")){
+        profile_ui<-list(
+            h1(paste("Participant Profile")),
+            span("This page shows details for a selected participant."),
+            profile_ui(ns("profile"))
+        )
+    }else{
+        profile_ui<-NULL
+    }
+    return(profile_ui) 
+}
+
+
+#' @title Server for the patient profile in safetyProfile::profile_server
+#'
+#' @param input Shiny input object
+#' @param output  Shiny output object
+#' @param session Shiny session object
+#' @param params reactive containing mapping and data
+#' @param current_id reactive containing currently selected participant
+#' 
+#' @return current_id
+#'
+#' @import datamods
+#' @importFrom shinyjs show hide
+#' @importFrom shiny renderDataTable
+#' 
+#' @export
+
+profileTab <- function(input, output, session, params) {
+    id <- safetyProfile::profile_server(
+        "profile",
+        params
+    )
+
+    observe({
+        shinyjs::html(
+            "pt-header", 
+            id(),
+            asis=TRUE    
+        )
+
+        shinyjs::toggleClass(
+            selector = "#pt-header",
+            class = "active",
+            condition = !is.null(id())
+        )
+    })
+
+    return(id)
+}

R/mod_safetyGraphicsServer.R

@@ -26,22 +26,22 @@ safetyGraphicsServer <- function(input, output, session,
     filterDomain,
     config
 ) {
-    # Initialize the Home tab
+    #--- Home tab ---#
     callModule(
         homeTab,
         "home",
         config
     )
 
-    # Initialize the Mapping tab - returns the current mapping as a reactive
+    #--- Mapping tab ---#
     current_mapping<-callModule(
         mappingTab,
         "mapping",
         meta,
         domainData
     )
 
-    # Initialize the Filter tab - returns list of filtered data as a reactive
+    #--- Filter tab ---#
     filtered_data<-callModule(
         filterTab, 
         "filter", 
@@ -50,16 +50,35 @@ safetyGraphicsServer <- function(input, output, session,
         current_mapping=current_mapping
     )
 
-    # Initialize Charts tab
-    # Initialize Chart UI - adds subtabs to chart menu and initializes the chart UIs
-    #charts %>% purrr::map(
-    #    ~chartsNav(
-    #        .x,
-    #        session$ns
-    #    )
-    #)
+    #--- Profile tab ---#
+    if(isNamespaceLoaded("safetyProfile")){
+        callModule(
+            profileTab, 
+            "profile", 
+            params = reactive({
+                list(
+                    data=filtered_data(), 
+                    settings=safetyGraphics::generateMappingList(current_mapping())
+                )
+            })
+        )
+
+        observeEvent(input$participants_selected, {
+            cli::cli_alert_info('Selected participant ID: {input$participants_selected}')
 
-    # Initialize Chart Servers
+            # Update selected participant.
+            updateSelectizeInput(
+                session,
+                inputId = 'profile-profile-idSelect',
+                selected = input$participants_selected
+            )
+        })
+    } else {
+        shinyjs::hide(selector = paste0(".navbar li a[data-value='profile']"))
+        shinyjs::hide(selector = paste0(".navbar #pt-header"))
+    }
+    
+    #--- Charts tab ---# 
     charts %>% purrr::walk(
         ~callModule(
             module=chartsNav,
@@ -70,7 +89,7 @@ safetyGraphicsServer <- function(input, output, session,
         )
     )
 
-    # Initialize the Setting tab
+    #--- Settings tab ---#
     callModule(
         settingsTab,
         "settings",

R/mod_safetyGraphicsUI.R

@@ -38,6 +38,24 @@ safetyGraphicsUI <- function(id,
             "\");"
         ))
     )
+
+    pt_selected<-tags$script(
+        HTML(paste0(
+            "var header = $('.navbar > .container-fluid');",
+            "header.append(\"",
+            "<div id='pt-header' class='badge' title='Selected Participant'>",
+            "None",
+            "</div>",
+            "\");",
+            "var ptheader = $('.navbar > .container-fluid > #pt-header');",
+            "ptheader.on('click',function(){",
+            "$('",
+            '[data-value="profile"]',
+            "').tab('show');",
+            "})"
+        ))
+    )
+    
     if(isNamespaceLoaded("shinybusy")){
         spinner<-shinybusy::add_busy_spinner(spin = "atom", position="bottom-right")
     }else{
@@ -80,10 +98,17 @@ safetyGraphicsUI <- function(id,
             tabPanel("Home", icon=icon("home"), homeTabUI(ns("home"))),
             tabPanel("Mapping", icon=icon("map"), mappingTabUI(ns("mapping"), meta, domainData, mapping, standards)),
             tabPanel("Filtering", icon=icon("filter"), filterTabUI(ns("filter"))),
+            tabPanel(
+                "Profile",
+                icon=icon("person"),
+                value='profile',
+                profileTabUI(ns("profile"))
+            ),
             chartNav,
             tabPanel('',icon=icon("cog"), settingsTabUI(ns("settings")))
         ),
-        participant_badge
+        participant_badge,
+        pt_selected
     )
     return(ui)
 }

inst/www/index.css

@@ -64,8 +64,20 @@ table.metatable.dataTable tr > td:last-of-type, table.metatable.trdataTable tr >
   margin-top:1em;
 }
 
+#pt-header.active {
+    background:#4B9CD3;
+    text-decoration:underline;
+    cursor:pointer;
+}
+
+#pt-header {
+  float: right;
+  margin-top: 1em;
+  margin-right:1em;
+}
+
 #population-header.subset {
-    background: blue;
+  background: green;
 }
 
 #dataSettings-previews .nav-tabs{