linking Long Stayers to the System Performance charts

changelog.R

@@ -6,7 +6,10 @@ output$changelog <- renderDT({
     "08-06-2026",
     "<b>Bug Fixes</b> <br>
       - Remove enrollments with no Bed Nights for 'Bed night entered on Project Exit Date' check (Issue <a href='https://github.com/abtassociates/eva/issues/1031' target='_blank'>#1031</a>)
-    ",
+    <b>New Features</b> <br>
+      - Adjust default Local Settings to be more project-type-specific <br>
+      - Connect Local Settings to System Performance <br>
+      - Make Local Settings a slide-out panel vs. a separate tab",
     "08-03-2026",
     "<b>Bug Fixes</b> <br>
       - Fixed System Exits Client-level Download functionality. It was causing an error when writing the output to an Excel file.<br>

data_quality_server.R

@@ -261,44 +261,22 @@ dq_full <- reactive({
 
   logToConsole(session, "in dq_full")
 
-  if(!is.null(session$userData$long_stayers) &&
-                     ('DaysSinceLastKnown' %in% names(session$userData$long_stayers))) {
-    long_stayers_tc <- tryCatch(
-      long_stayers <- session$userData$long_stayers %>%
-        fmutate(
-          too_many_days = case_match(
-            ProjectType,
-            es_nbn_project_type ~ input$ESNbNLongStayers,
-            out_project_type ~ input$OUTLongStayers,
-            sso_project_type ~ input$ServicesOnlyLongStayers,
-            other_project_project_type ~ input$OtherLongStayers,
-            day_project_type ~ input$DayShelterLongStayers,
-            ce_project_type ~ input$CELongStayers
-          )
-        ) %>% 
-        fsubset(DaysSinceLastKnown > too_many_days) %>%
-        fselect(vars_we_want) %>%
-        fmutate(Type = factor(Type, levels = issue_levels)),
-     error = function(e){e}
-    )
+  if(!is.null(session$userData$long_stayers)) {
+
 
     if(inherits(long_stayers_tc, 'simpleError')){
       logToConsole(session, paste0('Error in long_stayers_tc... colnames: ', paste0(names(session$userData$long_stayers), collapse=',')))
 
       long_stayers <- data.table()
     } else {
-      long_stayers <- long_stayers_tc
+      long_stayers <- long_stayers_tc()
     }
   } else {
     long_stayers <- data.table()
   }
 
   if(!is.null(session$userData$outstanding_referrals) > 0) {
-    outstanding_referrals <- session$userData$outstanding_referrals %>%
-      fsubset(input$CEOutstandingReferrals < Days) %>%
-      merge_check_info(checkIDs = 100) %>%
-      fselect(vars_we_want) %>%
-      fmutate(Type = factor(Type, levels = issue_levels))
+    outstanding_referrals <- outstanding_referrals_tc()
   } else {
     outstanding_referrals <- data.table()
   }

local_settings_server.R

@@ -0,0 +1,164 @@
+# 1. Initialize previous states with current values (using isolate to prevent reactive cycles)
+prev_long_stayers <- reactiveValues(
+  "session$userData$valid_file" = isolate(session$userData$valid_file()),
+  "input$ESNbNLongStayers"        = isolate(input$ESNbNLongStayers),
+  "input$OUTLongStayers"          = isolate(input$OUTLongStayers),
+  "input$ServicesOnlyLongStayers" = isolate(input$ServicesOnlyLongStayers),
+  "input$OtherLongStayers"        = isolate(input$OtherLongStayers),
+  "input$DayShelterLongStayers"   = isolate(input$DayShelterLongStayers),
+  "input$CELongStayers"           = isolate(input$CELongStayers)
+)
+
+# 2. Group all inputs into a single reactive list
+long_stayers_group <- reactive({
+  list(
+    "input$ESNbNLongStayers"        = input$ESNbNLongStayers,
+    "input$OUTLongStayers"          = input$OUTLongStayers,
+    "input$ServicesOnlyLongStayers" = input$ServicesOnlyLongStayers,
+    "input$OtherLongStayers"        = input$OtherLongStayers,
+    "input$DayShelterLongStayers"   = input$DayShelterLongStayers,
+    "input$CELongStayers"           = input$CELongStayers
+  )
+})
+
+# 3. Apply debounce to the grouped reactive expression
+long_stayers_debounced <- debounce(long_stayers_group, 2000)
+
+
+observeEvent(input$toggle_help, {
+  shinyjs::toggleClass(id = "help_sidebar", class = "open")
+})
+
+# 2. Close via X button inside the sidebar
+observeEvent(input$close_help, {
+  shinyjs::removeClass(id = "help_sidebar", class = "open")
+})
+
+# Log changes to metadata
+observeEvent(long_stayers_debounced(), {
+  curr_values <- long_stayers_debounced()
+  changed_input <- NULL
+
+  # Identify which input changed and update the tracked state
+  for (input_name in names(curr_values)) {
+    if (!identical(curr_values[[input_name]], prev_long_stayers[[input_name]])) {
+      changed_input <- input_name
+      prev_long_stayers[[input_name]] <- curr_values[[input_name]]
+    }
+  }
+  logMetadata(session, paste0("Changed long stayer setting: ", changed_input))
+})
+
+## DQ - Long Stayers
+get_long_stayers <- function() {
+  tryCatch(
+    session$userData$long_stayers %>%
+      fmutate(
+        too_many_days = fcase(
+          ProjectType == es_nbn_project_type, input$ESNbNLongStayers,
+          ProjectType == out_project_type, input$OUTLongStayers,
+          ProjectType == sso_project_type, input$ServicesOnlyLongStayers,
+          ProjectType == other_project_project_type, input$OtherLongStayers,
+          ProjectType == day_project_type, input$DayShelterLongStayers,
+          ProjectType == ce_project_type, input$CELongStayers,
+          default = 99999
+        )
+      ) %>%
+      fsubset(DaysSinceLastKnown > too_many_days) %>%
+      fselect(vars_we_want) %>%
+      fmutate(Type = factor(Type, levels = issue_levels)),
+    error = function(e){e}
+  )
+}
+
+get_outstanding_referrals <- function() {
+  tryCatch(
+    session$userData$outstanding_referrals %>%
+      fsubset(input$CEOutstandingReferrals < Days) %>%
+      merge_check_info(checkIDs = 100) %>%
+      fselect(vars_we_want) %>%
+      fmutate(Type = factor(Type, levels = issue_levels)),
+    error = function(e){e}
+  )
+}
+long_stayers_tc <- reactiveVal(NULL)
+outstanding_referrals_tc <- reactiveVal(NULL)
+
+observeEvent(input$update_dq, {
+  long_stayers_tc(get_long_stayers())
+  outstanding_referrals_tc(get_outstanding_referrals())
+
+  show_alert("Long Stayer and CE Outstanding Referral DQ checks have been updated!", "Your Long Stayer and CE Outstanding Referral DQ checks have been updated", type = "success")
+  shinyjs::toggleState("update_dq", condition = FALSE)
+})
+
+
+## System Performance - days_lh_valid
+set_user_data_lh_info <- function() {
+  session$userData$lh_info <- get_lh_info(
+    session$userData$enrollment_categories, 
+    session$userData$lh_cls,
+    session$userData$Services,
+    session$userData$ReportStart, 
+    session$userData$ReportEnd
+  )
+
+  cols_to_overwrite <- c(
+    "first_lh_date", 
+    "last_lh_date", 
+    "EntryDate_orig",
+    "ExitAdjust_orig", 
+    "adjusted_dates"
+  )
+  session$userData$enrollment_categories <- trim_entry_exit(
+    session$userData$enrollment_categories %>% get_vars(setdiff(names(.), cols_to_overwrite)),
+    session$userData$lh_info
+  )
+
+  # Force run/calculate period_specific_data reactive
+  # Better to do it up-front than while charts are loading
+  period_specific_data()
+
+  session$userData$lh_info_prev <- get_lh_info(
+    session$userData$enrollment_categories_prev, 
+    session$userData$lh_cls,
+    session$userData$Services,
+    session$userData$ReportStart, 
+    session$userData$ReportEnd
+  )
+
+  session$userData$enrollment_categories_prev <- trim_entry_exit(
+    session$userData$enrollment_categories_prev %>% get_vars(setdiff(names(.), cols_to_overwrite)),
+    session$userData$lh_info_prev
+  )
+}
+observeEvent(input$update_sys_perf, {
+  req(session$userData$valid_file() == 1)
+
+  curr_values <- long_stayers_debounced()
+  changed_input <- NULL
+  browser()
+  # Identify which input changed and update the tracked state
+  for (input_name in names(curr_values)) {
+    if (!identical(curr_values[[input_name]], prev_long_stayers[[input_name]])) {
+      changed_input <- input_name
+      prev_long_stayers[[input_name]] <- curr_values[[input_name]]
+    }
+  }
+
+  # Log the metadata with the specific input that changed
+  if (!is.null(changed_input)) {
+    browser()
+  }
+
+  set_user_data_lh_info()
+
+  show_alert("System Performance Updated!", "Your System Performance dashboard has been updated", type = "success")
+  shinyjs::toggleState("update_sys_perf", condition = FALSE)
+}, ignoreInit = FALSE, ignoreNULL = TRUE)
+
+observeEvent(long_stayers_debounced(), {
+  show <- session$userData$valid_file() == 1
+  shinyjs::toggleState("update_dq", condition = show)
+  shinyjs::toggleState("update_sys_perf", condition = show)
+})

server.R

@@ -133,9 +133,11 @@ function(input, output, session) {
   })
 
   source("upload_server.R", local=TRUE)
-
+
+  source("local_settings_server.R", local=TRUE)
+
   source("project_dashboard_server.R", local = TRUE)
-  
+
   source("fsa_server.R", local = TRUE)
 
   source("data_quality_server.R", local = TRUE)

system_overview_server.R

@@ -276,7 +276,7 @@ syso_client_categories_filtered <- reactive({
 get_active_info <- function(all_filtered_by_period, all_filtered, lh_info_df = session$userData$lh_info,
                             reportStart = session$userData$ReportStart, reportEnd = session$userData$ReportEnd) {
   logToConsole(session, "In get_active_info")
-
+    
   lh_info_filtered <- lh_info_df %>%
     fselect(-first_lh_date, -last_lh_date, -lh_prior_livingsituation) %>%
     join(
@@ -1074,4 +1074,121 @@ inflow_outflow_qc_checks <- function(inflows_and_outflows_clean) {
 
 }
 
-syso_enrollments_filtered <- create_filtered_enrollments_reactive("syso")
+get_lh_info <- function(enrollment_categories, lh_cls, Services, reportStart, reportEnd) {
+  # This step does 2 things:
+  #  1. Compute lh_date, first_lh_date. and last_lh_date
+  #  2. Modify EntryDate and ExitAdjust to be these first and last LH dates. 
+  #     (Only applicable to non-res projects with no LH PLS or no ExitDate, but with an LH CLS)
+  # lh_date is the InformationDate (Non-Res) or DateProvided (ES-NbN) 
+  # first_lh_date and last_lh_date are also used to determine days_since_last_lh. And first_lh_date is used for the FTH Inflow status
+  lh_info <- enrollment_categories %>%
+    # The purpose of days_lh_valid is to capture the idea that an LH date (LH PLS, LH CLS, or Bed Night)
+    # Can tell us something about a person's LH status for some time beyond that particular date
+    # In this way, it will help us construct an enrollment's last LH date
+    # It also helps us determine if an enrollment is LH at period start/end, 
+    # by looking back from the period start/end this number of days to see if there's an LH date
+    fmutate(days_lh_valid = get_days_lh_valid(.)) %>%
+    join(lh_cls %>% frename(InformationDate = lh_date) %>% funique(), on="EnrollmentID", multiple =TRUE) %>%
+    join(Services %>% fselect(EnrollmentID, lh_date_s = DateProvided) %>% funique(), on="EnrollmentID", multiple =TRUE) %>%
+    fmutate(
+      lh_date = fcoalesce(lh_date, lh_date_s),
+      non_exit_lh_in_report = 
+        ((EntryDate + days_lh_valid) %between% list(reportStart, reportEnd) & lh_prior_livingsituation) |
+        (lh_date + days_lh_valid) %between% list(reportStart, reportEnd)
+    ) %>%
+    fgroup_by(EnrollmentID) %>%
+    fmutate(exit_is_only_lh = !any(non_exit_lh_in_report, na.rm=TRUE)) %>%
+    fungroup() %>%
+    fmutate(
+      first_lh_compare_date = pmin(
+        fifelse(MoveInDateAdjust <= reportStart, NA, ExitAdjust),
+        fifelse(
+          lh_at_entry,
+          EntryDate,
+          fifelse(lh_date < EntryDate, ExitAdjust, lh_date)
+        ),
+        na.rm=TRUE
+      ),
+      last_lh_compare_date = pmax(
+        pmin(lh_date + days_lh_valid, ExitAdjust), # Handle if lh_date + days_lh_valid goes beyond ExitDate.
+        fifelse(!exit_is_only_lh & !ProjectType %in% non_res_project_types, ExitDate, NA), # For non-res projects, we don't use ExitDate. LH_date + days_lh_valid is sufficient
+        fifelse(
+          lh_at_entry,
+          pmin(EntryDate + days_lh_valid, ExitAdjust),
+          NA
+        ),
+        na.rm=TRUE
+      )
+    ) %>%
+    fgroup_by(EnrollmentID) %>%
+    fmutate(
+      first_lh_date = fmin(first_lh_compare_date),
+      last_lh_date = fmax(last_lh_compare_date)
+    ) %>%
+    ftransform(
+      last_lh_date = fifelse(
+        ProjectType %in% c(lh_project_types_nonbn, ph_project_types),
+        fcoalesce(MoveInDateAdjust, ExitAdjust),
+        last_lh_date
+      )
+    ) %>%
+    fungroup() %>%
+    fselect(
+      PersonalID, 
+      EnrollmentID,
+      ProjectType, 
+      MoveInDateAdjust,
+      lh_prior_livingsituation, 
+      days_lh_valid,
+      lh_date,
+      first_lh_date,
+      last_lh_date,
+      EntryDate, ExitAdjust
+    )
+  return(lh_info)
+}
+
+trim_entry_exit <- function(enrollment_categories, lh_info) {
+  dt <- enrollment_categories %>%
+    join(
+      lh_info %>% fselect(EnrollmentID, first_lh_date, last_lh_date, days_lh_valid) %>% funique(),
+      on = "EnrollmentID"
+    ) %>%
+    fmutate(
+      # "Trimming" EntryDate and ExitAdjust for non-res and NbN projects
+      # This is because such projects SHOULD have an LH CLS when they enter, but don't always do this.
+      # So we set Entry and Exit to the first/last LH dates in these cases.
+      EntryDate_orig = EntryDate,
+
+      ExitAdjust_orig = ExitAdjust,
+
+      EntryDate = fifelse(
+        ProjectType %in% c(lh_project_types_nonbn, ph_project_types, out_project_type, es_nbn_project_type),
+        EntryDate,
+        first_lh_date
+      ),
+      ExitAdjust = fifelse(
+        ProjectType %in% nbn_non_res & ExitAdjust == no_end_date,
+        last_lh_date,
+        ExitAdjust
+      ),
+      adjusted_dates = EntryDate != EntryDate_orig | ExitAdjust != ExitAdjust_orig
+    ) %>%
+    fsubset(EntryDate < ExitAdjust) # After trimming, want to ensure that the new EntryDate < new ExitAdjust
+  return(dt)
+}
+
+
+get_days_lh_valid <- function(dt) {
+  fcase(
+    dt$ProjectType == ce_project_type, as.numeric(input$CELongStayers),
+    dt$ProjectType == out_project_type, as.numeric(input$OUTLongStayers),
+    dt$ProjectType == sso_project_type, as.numeric(input$ServicesOnlyLongStayers),
+    dt$ProjectType == other_project_project_type, as.numeric(input$OtherLongStayers),
+    dt$ProjectType == day_project_type, as.numeric(input$DayShelterLongStayers),
+    dt$ProjectType == es_nbn_project_type, as.numeric(input$ESNbNLongStayers),
+    dt$ProjectType %in% c(lh_project_types_nonbn, ph_project_types), as.numeric(pmin(dt$MoveInDateAdjust, dt$ExitAdjust, no_end_date, na.rm=TRUE) - dt$EntryDate),
+    default = as.numeric(0)
+  )
+}
+syso_enrollments_filtered <- create_filtered_enrollments_reactive("syso")

tab_instructions.R

@@ -218,9 +218,9 @@ tabLocalSettings_instructions <-  HTML("
               <p>To make Eva data quality analysis more useful at the local level, 
               you can adjust the local settings to better analyze your data in a 
               way that is meaningful to your CoC. To edit these, click to expand 
-              the relevant box below. If you do not edit them, the Data Quality 
-              and Client Counts pages will use the defaults listed. Please 
-              note, these local settings do not impact the System Performance Overview page.</p>
+              the relevant box below. If you do not edit them, the Project Dashboard,
+              Data Quality, and System Performance pages will use the defaults 
+              listed.</p>
 
               <p>These defaults do not imply any HUD recommendations. Please read 
               the description in the Local Settings tab for more information.</p>