Skip to content

[revised 8-14-25] system_performance_measures_5.R #28

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open

[revised 8-14-25] system_performance_measures_5.R #28

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
172 changes: 137 additions & 35 deletions System Performance Measures/system_performance_measures_5.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,9 @@
# GNU Affero General Public License for more details at
# <https://www.gnu.org/licenses/>.

library(dplyr)
library(lubridate)

items_to_keep <- c(items_to_keep,
do.call(paste0, expand.grid("spm_5.", c("1", "2"), c("_dq", ""))))

Expand All @@ -19,9 +22,32 @@ items_to_keep <- c(items_to_keep,

#### SCRIPT START

# Helper function for debugging missing clients
debug_missing_clients <- function(missing_ids, universe_data, verbose = FALSE) {
if (verbose && length(missing_ids) > 0) {
message("=== Debugging Missing Clients ===")
for (id in missing_ids) {
client_enrollments <- active_enrollments %>%
filter(PersonalID == id) %>%
select(PersonalID, EnrollmentID, ProjectType, EntryDate, ExitDate) %>%
arrange(EntryDate)

message(paste("PersonalID:", id))
message("Enrollments:")
print(client_enrollments)

# Check if client appears in universe
in_universe <- id %in% universe_data$PersonalID
message(paste("In universe:", in_universe))
message("---")
}
message("=== End Debugging ===")
}
}

## define report range universes ----

### 5.1 (ES, SH, TH, PH) ----
### 5.1 (ES, SH, TH) ----
Q5M1_report <- active_enrollments %>%
filter(ProjectType %in% c(0, 1, 2, 8) &
EntryDate >= report_start_date &
Expand All @@ -30,57 +56,63 @@ Q5M1_report <- active_enrollments %>%
arrange(EntryDate, EnrollmentID) %>%
slice(1L) %>%
mutate(
client_lookbackdate = max(EntryDate %m-% days(730), lookback_stop_date)) %>%
client_lookbackdate = pmax(EntryDate - days(730), lookback_stop_date)) %>%
ungroup() %>%
rename("client_startdate" = "EntryDate") %>%
select(PersonalID, client_startdate, client_lookbackdate)


### 5.2 (ES, SH, TH, PH) ----
Q5M2_report <- active_enrollments %>%
filter(ProjectType %in% c(0, 1, 2, 8, 3, 9, 10, 13) &
EntryDate >= report_start_date &
EntryDate <= report_end_date) %>%
group_by(PersonalID) %>%
arrange(EntryDate, EnrollmentID) %>%
slice(1L) %>%
# Don't deduplicate at PersonalID level yet - we need ALL entries
# that fall within the report period for proper lookback calculation
mutate(
client_lookbackdate = max( EntryDate %m-% days(730), lookback_stop_date )) %>%
ungroup() %>%
rename( "client_startdate" = "EntryDate") %>%
select(PersonalID, client_startdate, client_lookbackdate)
client_lookbackdate = pmax(EntryDate - days(730), lookback_stop_date)
) %>%
rename("client_startdate" = "EntryDate") %>%
select(PersonalID, EnrollmentID, ProjectType, client_startdate, client_lookbackdate)

# Debug the specific missing clients
missing_client_ids <- c(398555, 610622, 610623, 635887, 635888, 683471, 697596, 697597, 699471, 702806)

# Optional debugging - set to TRUE to enable
debug_mode <- FALSE
if (debug_mode) {
debug_missing_clients(missing_client_ids, Q5M2_report, verbose = TRUE)
}

## calculations ----

spm_5.1_dq <- Q5M1_report %>%
left_join(enrollment_data %>%
mutate(
capped_exit_date = if_else(is.na(ExitDate),
report_end_date,
ExitDate)) %>%
filter(ProjectType %in% c(0, 1, 2, 8, 3, 9, 10, 13)),
join_by(PersonalID,
client_startdate > EntryDate,
client_lookbackdate <= capped_exit_date))

spm_5.2_dq <- Q5M2_report %>%
left_join(enrollment_data %>%
mutate(
capped_exit_date = if_else(is.na(ExitDate),
report_end_date,
ExitDate)) %>%
filter(ProjectType %in% c(0, 1, 2, 8, 3, 9, 10, 13)),
join_by(PersonalID,
client_startdate > EntryDate,
client_lookbackdate <= capped_exit_date))
# Lookback join logic with error handling for overlapping enrollment
create_lookback_join <- function(report_data, enrollment_source) {
report_data %>%
left_join(
enrollment_source %>%
mutate(
capped_exit_date = if_else(is.na(ExitDate),
report_end_date,
ExitDate)
) %>%
filter(ProjectType %in% c(0, 1, 2, 8, 3, 9, 10, 13)),
join_by(PersonalID,
client_startdate > EntryDate,
client_lookbackdate <= capped_exit_date),
relationship = "many-to-many" # Allow multiple matches per client
)
}

spm_5.1_dq <- create_lookback_join(Q5M1_report, enrollment_data)

spm_5.2_dq <- create_lookback_join(Q5M2_report, enrollment_data)

### counts of report persons ----
Q5M1_C2 <- spm_5.1_dq %>%
Q5M1_C2 <- Q5M1_report %>%
summarise(people = n_distinct(PersonalID)) %>%
.$people

Q5M2_C2 <- spm_5.2_dq %>%
Q5M2_C2 <- Q5M2_report %>%
summarise(people = n_distinct(PersonalID)) %>%
.$people

Expand All @@ -103,6 +135,31 @@ Q5M2_C3 <- spm_5.2_dq %>%
Q5M1_C4 <- Q5M1_C2 - Q5M1_C3
Q5M2_C4 <- Q5M2_C2 - Q5M2_C3

# Additional validation for SPM 5.2
validate_spm5_results <- function() {
message("=== SPM 5 Validation ===")
message(paste("SPM 5.1 Universe:", Q5M1_C2))
message(paste("SPM 5.1 In Lookback:", Q5M1_C3))
message(paste("SPM 5.1 First Time:", Q5M1_C4))
message("---")
message(paste("SPM 5.2 Universe:", Q5M2_C2))
message(paste("SPM 5.2 In Lookback:", Q5M2_C3))
message(paste("SPM 5.2 First Time:", Q5M2_C4))

# Check if previously missing clients are now included
missing_now_included <- sum(missing_client_ids %in% Q5M2_report$PersonalID)
message(paste("Previously missing clients now included:", missing_now_included, "out of", length(missing_client_ids)))

if (missing_now_included < length(missing_client_ids)) {
still_missing <- missing_client_ids[!missing_client_ids %in% Q5M2_report$PersonalID]
message(paste("Still missing PersonalIDs:", paste(still_missing, collapse = ", ")))
}
message("=== End Validation ===")
}

# Uncomment to run validation
# validate_spm5_results()

## build output tables ----

### row headers ----
Expand All @@ -124,10 +181,55 @@ Difference <- as.character(c("", "", ""))

### measure value columns ----
Current.FY.5.1 <- as.character(c(Q5M1_C2, Q5M1_C3, Q5M1_C4))
Current.FY.5.2 <- as.character(c(Q5M2_C2, Q5M2_C3, Q5M2_C4 ))
Current.FY.5.2 <- as.character(c(Q5M2_C2, Q5M2_C3, Q5M2_C4))

### table assembly ----
spm_5.1 <- data.frame(cbind(Q5M1_Col_A, Previous.FY, Current.FY.5.1, Difference))
spm_5.2 <- data.frame(cbind(Q5M2_Col_A, Previous.FY, Current.FY.5.2, Difference))

rm(list = ls()[ls() %nin% items_to_keep])
# Debugging function for specific client analysis
analyze_specific_client <- function(personal_id, verbose = TRUE) {
if (!verbose) return(NULL)

message(paste("=== Analyzing PersonalID:", personal_id, "==="))

# Get all enrollments for this client
client_enrollments <- active_enrollments %>%
filter(PersonalID == personal_id) %>%
arrange(EntryDate) %>%
select(PersonalID, EnrollmentID, ProjectType, EntryDate, ExitDate, MoveInDate)

message("All enrollments:")
print(client_enrollments)

# Check if in report period
report_period_enrollments <- client_enrollments %>%
filter(EntryDate >= report_start_date & EntryDate <= report_end_date)

message("Enrollments in report period:")
print(report_period_enrollments)

# Check if in SPM 5.2 universe
in_universe <- personal_id %in% Q5M2_report$PersonalID
message(paste("In SPM 5.2 universe:", in_universe))

if (in_universe) {
universe_record <- Q5M2_report %>% filter(PersonalID == personal_id)
message("Universe record:")
print(universe_record)
}

message("=== End Analysis ===")
}

# Function to analyze all missing clients
analyze_all_missing_clients <- function() {
for (id in missing_client_ids) {
analyze_specific_client(id, verbose = TRUE)
}
}

# Uncomment to analyze specific missing clients
# analyze_all_missing_clients()

rm(list = ls()[ls() %nin% items_to_keep])