Make improvements to test workbooks (#849)

Opening as a draft PR for now to see changes. I have tested the episode
file and happy it works as expected but having trouble with the
individual file tests. I would like to test these before marking ready
for review.

Test workbooks to check:
- [x] episode file
- [x] individual file
- [x] extracts
- [x] lookups

NAMESPACE

@@ -166,6 +166,7 @@ export(read_sc_all_alarms_telecare)
 export(read_sc_all_care_home)
 export(read_sc_all_home_care)
 export(read_sc_all_sds)
+export(rename_hscp)
 export(setup_keyring)
 export(start_fy)
 export(start_fy_quarter)

R/get_existing_data_for_tests.R

@@ -51,9 +51,6 @@ get_existing_data_for_tests <- function(new_data, file_version = "episode", anon
       recids = recids,
       col_select = variable_names
     ))
-    if ("hscp2018" %in% variable_names) {
-      slf_data <- dplyr::rename(slf_data, "hscp" = "hscp2018")
-    }
   } else {
     slf_data <- suppressMessages(slfhelper::read_slf_individual(
       year = year,

R/get_source_extract_path.R

@@ -64,7 +64,7 @@ get_source_extract_path <- function(year,
     "pis" ~ "prescribing_file_for_source",
     "sds" ~ "sds-for-source"
   ) %>%
-    stringr::str_glue("-{year}.parquet")
+    stringr::str_glue("-20{year}.parquet")
 
   source_extract_path <- get_file_path(
     directory = get_year_dir(year),

R/process_tests_acute.R

@@ -12,11 +12,13 @@
 process_tests_acute <- function(data, year) {
   old_data <- get_existing_data_for_tests(data)
 
+  data <- rename_hscp(data)
+
   comparison <- produce_test_comparison(
     old_data = produce_source_extract_tests(old_data),
     new_data = produce_source_extract_tests(data)
   ) %>%
-    write_tests_xlsx(sheet_name = "01B", year)
+    write_tests_xlsx(sheet_name = "01B", year, workbook_name = "extract")
 
   return(comparison)
 }

R/process_tests_ae.R

@@ -9,6 +9,8 @@
 process_tests_ae <- function(data, year) {
   old_data <- get_existing_data_for_tests(data)
 
+  data <- rename_hscp(data)
+
   comparison <- produce_test_comparison(
     old_data = produce_source_extract_tests(old_data,
       sum_mean_vars = "cost",
@@ -19,7 +21,7 @@ process_tests_ae <- function(data, year) {
       max_min_vars = c("record_keydate1", "record_keydate2", "cost_total_net")
     )
   ) %>%
-    write_tests_xlsx(sheet_name = "AE2", year)
+    write_tests_xlsx(sheet_name = "AE2", year, workbook_name = "extract")
 
   return(comparison)
 }

R/process_tests_alarms_telecare.R

@@ -10,13 +10,15 @@
 process_tests_alarms_telecare <- function(data, year) {
   old_data <- get_existing_data_for_tests(data)
 
+  data <- rename_hscp(data)
+
   comparison <- produce_test_comparison(
     old_data = produce_source_at_tests(old_data),
     new_data = produce_source_at_tests(data)
   )
 
   comparison %>%
-    write_tests_xlsx(sheet_name = "AT", year)
+    write_tests_xlsx(sheet_name = "AT", year, workbook_name = "extract")
 
   return(comparison)
 }

R/process_tests_care_home.R

@@ -9,11 +9,13 @@
 process_tests_care_home <- function(data, year) {
   old_data <- get_existing_data_for_tests(data)
 
+  data <- rename_hscp(data)
+
   comparison <- produce_test_comparison(
     old_data = produce_source_ch_tests(old_data),
     new_data = produce_source_ch_tests(data)
   ) %>%
-    write_tests_xlsx(sheet_name = "CH", year)
+    write_tests_xlsx(sheet_name = "CH", year, workbook_name = "extract")
 
   return(comparison)
 }

R/process_tests_cmh.R

@@ -14,11 +14,13 @@ process_tests_cmh <- function(data, year) {
 
   old_data <- get_existing_data_for_tests(data)
 
+  data <- rename_hscp(data)
+
   comparison <- produce_test_comparison(
     old_data = produce_source_cmh_tests(old_data),
     new_data = produce_source_cmh_tests(data)
   ) %>%
-    write_tests_xlsx(sheet_name = "CMH", year)
+    write_tests_xlsx(sheet_name = "CMH", year, workbook_name = "extract")
 
   return(comparison)
 }

R/process_tests_delayed_discharges.R

@@ -12,11 +12,13 @@
 process_tests_delayed_discharges <- function(data, year) {
   old_data <- get_existing_data_for_tests(data)
 
+  data <- rename_hscp(data)
+
   comparison <- produce_test_comparison(
     old_data = produce_source_dd_tests(old_data),
     new_data = produce_source_dd_tests(data)
   ) %>%
-    write_tests_xlsx(sheet_name = "DD", year)
+    write_tests_xlsx(sheet_name = "DD", year, workbook_name = "extract")
 
   return(comparison)
 }

R/process_tests_district_nursing.R

@@ -21,11 +21,13 @@ process_tests_district_nursing <- function(data, year) {
       ~ tidyr::replace_na(.x, 0.0)
     ))
 
+  data <- rename_hscp(data)
+
   comparison <- produce_test_comparison(
     old_data = produce_source_dn_tests(old_data),
     new_data = produce_source_dn_tests(data)
   ) %>%
-    write_tests_xlsx(sheet_name = "dn", year)
+    write_tests_xlsx(sheet_name = "dn", year, workbook_name = "extract")
 
   return(comparison)
 }

R/process_tests_episode_file.R

@@ -31,7 +31,7 @@ process_tests_episode_file <- function(data, year) {
     recid = TRUE
   ) %>%
     dplyr::arrange(.data[["recid"]]) %>%
-    write_tests_xlsx(sheet_name = "ep_file", year)
+    write_tests_xlsx(sheet_name = "ep_file", year, workbook_name = "ep_file")
 
   return(comparison)
 }

R/process_tests_gp_ooh.R

@@ -9,6 +9,8 @@
 process_tests_gp_ooh <- function(data, year) {
   old_data <- get_existing_data_for_tests(data)
 
+  data <- rename_hscp(data)
+
   comparison <- produce_test_comparison(
     old_data = produce_source_extract_tests(old_data,
       sum_mean_vars = "cost"
@@ -17,7 +19,7 @@ process_tests_gp_ooh <- function(data, year) {
       sum_mean_vars = "cost"
     )
   ) %>%
-    write_tests_xlsx(sheet_name = "GPOoH", year)
+    write_tests_xlsx(sheet_name = "GPOoH", year, workbook_name = "extract")
 
   return(comparison)
 }

R/process_tests_home_care.R

@@ -9,13 +9,15 @@
 process_tests_home_care <- function(data, year) {
   old_data <- get_existing_data_for_tests(data)
 
+  data <- rename_hscp(data)
+
   comparison <- produce_test_comparison(
     old_data = produce_source_hc_tests(old_data),
     new_data = produce_source_hc_tests(data)
   )
 
   comparison %>%
-    write_tests_xlsx(sheet_name = "home_care", year)
+    write_tests_xlsx(sheet_name = "home_care", year, workbook_name = "extract")
 
   return(comparison)
 }

R/process_tests_homelessness.R

@@ -10,11 +10,13 @@
 process_tests_homelessness <- function(data, year) {
   old_data <- get_existing_data_for_tests(data)
 
+  data <- rename_hscp(data)
+
   comparison <- produce_test_comparison(
     old_data = produce_slf_homelessness_tests(old_data),
     new_data = produce_slf_homelessness_tests(data)
   ) %>%
-    write_tests_xlsx(sheet_name = "HL1", year)
+    write_tests_xlsx(sheet_name = "HL1", year, workbook_name = "extract")
 
   return(comparison)
 }

R/process_tests_individual_file.R

@@ -26,16 +26,15 @@ process_tests_individual_file <- function(data, year) {
         "cases",
         "consultations"
       ))
-    ) %>%
-    slfhelper::get_chi()
+    )
 
-  old_data <- get_existing_data_for_tests(data, file_version = "individual")
+  old_data <- get_existing_data_for_tests(data, file_version = "individual", anon_chi = TRUE)
 
   comparison <- produce_test_comparison(
     old_data = produce_individual_file_tests(old_data),
     new_data = produce_individual_file_tests(data)
   ) %>%
-    write_tests_xlsx(sheet_name = "indiv_file", year)
+    write_tests_xlsx(sheet_name = "indiv_file", year, workbook_name = "indiv_file")
 
   return(comparison)
 }
@@ -61,11 +60,19 @@ produce_individual_file_tests <- function(data) {
 
   test_flags <- data %>%
     # use functions to create HB and partnership flags
-    create_demog_test_flags() %>%
+    dplyr::mutate(
+      unique_anon_chi = dplyr::lag(.data$anon_chi) != .data$anon_chi,
+      n_missing_anon_chi = is_missing(.data$anon_chi),
+      n_males = .data$gender == 1L,
+      n_females = .data$gender == 2L,
+      n_postcode = !is.na(.data$postcode) | !.data$postcode == "",
+      n_missing_postcode = is_missing(.data$postcode),
+      missing_dob = is.na(.data$dob)
+    ) %>%
     create_hb_test_flags(.data$hbrescode) %>%
     create_hb_cost_test_flags(.data$hbrescode, .data$health_net_cost) %>%
     # keep variables for comparison
-    dplyr::select(c("valid_chi":dplyr::last_col())) %>%
+    dplyr::select(c("unique_anon_chi":dplyr::last_col())) %>%
     # use function to sum new test flags
     calculate_measures(measure = "sum")
 

R/process_tests_it_chi_deaths.R

@@ -10,7 +10,7 @@ process_tests_it_chi_deaths <- function(data, update = previous_update()) {
     ),
     new_data = produce_it_chi_deaths_tests(data)
   ) %>%
-    write_tests_xlsx(sheet_name = "it_chi_deaths")
+    write_tests_xlsx(sheet_name = "it_chi_deaths", workbook_name = "lookup")
 
   return(comparison)
 }

R/process_tests_lookup_gpprac.R

@@ -13,7 +13,7 @@ process_tests_lookup_gpprac <- function(data, update = previous_update()) {
     ),
     new_data = produce_slf_gpprac_tests(data)
   ) %>%
-    write_tests_xlsx(sheet_name = "source_gpprac_lookup")
+    write_tests_xlsx(sheet_name = "source_gpprac_lookup", workbook_name = "lookup")
 
   return(comparison)
 }

R/process_tests_lookup_pc.R

@@ -17,7 +17,7 @@ process_tests_lookup_pc <- function(data, update = previous_update()) {
     ),
     new_data = produce_slf_postcode_tests(data)
   ) %>%
-    write_tests_xlsx(sheet_name = "source_pc_lookup")
+    write_tests_xlsx(sheet_name = "source_pc_lookup", workbook_name = "lookup")
 
   return(comparison)
 }

R/process_tests_ltcs.R

@@ -23,7 +23,7 @@ process_tests_ltcs <- function(data, year) {
       issue = NA
     ) %>%
     # Save test comparisons as an excel workbook
-    write_tests_xlsx(sheet_name = "ltc", year = year)
+    write_tests_xlsx(sheet_name = "ltc", year = year, workbook_name = "extract")
 
   return(duplicates)
 }

R/process_tests_maternity.R

@@ -9,11 +9,13 @@
 process_tests_maternity <- function(data, year) {
   old_data <- get_existing_data_for_tests(data)
 
+  data <- rename_hscp(data)
+
   comparison <- produce_test_comparison(
     old_data = produce_source_extract_tests(old_data),
     new_data = produce_source_extract_tests(data)
   ) %>%
-    write_tests_xlsx(sheet_name = "02B", year)
+    write_tests_xlsx(sheet_name = "02B", year, workbook_name = "extract")
 
   return(comparison)
 }

R/process_tests_mental_health.R

@@ -9,11 +9,13 @@
 process_tests_mental_health <- function(data, year) {
   old_data <- get_existing_data_for_tests(data)
 
+  data <- rename_hscp(data)
+
   comparison <- produce_test_comparison(
     old_data = produce_source_extract_tests(old_data),
     new_data = produce_source_extract_tests(data)
   ) %>%
-    write_tests_xlsx(sheet_name = "04B", year)
+    write_tests_xlsx(sheet_name = "04B", year, workbook_name = "extract")
 
   return(comparison)
 }

R/process_tests_nrs_deaths.R

@@ -9,11 +9,13 @@
 process_tests_nrs_deaths <- function(data, year) {
   old_data <- get_existing_data_for_tests(data)
 
+  data <- rename_hscp(data)
+
   comparison <- produce_test_comparison(
     old_data = produce_source_nrs_tests(old_data),
     new_data = produce_source_nrs_tests(data)
   ) %>%
-    write_tests_xlsx(sheet_name = "NRS", year)
+    write_tests_xlsx(sheet_name = "NRS", year, workbook_name = "extract")
 
   return(comparison)
 }

R/process_tests_outpatients.R

@@ -9,6 +9,8 @@
 process_tests_outpatients <- function(data, year) {
   old_data <- get_existing_data_for_tests(data)
 
+  data <- rename_hscp(data)
+
   comparison <- produce_test_comparison(
     old_data = produce_source_extract_tests(old_data,
       sum_mean_vars = "cost",
@@ -21,7 +23,7 @@ process_tests_outpatients <- function(data, year) {
       add_hscp_count = FALSE
     )
   ) %>%
-    write_tests_xlsx(sheet_name = "00B", year)
+    write_tests_xlsx(sheet_name = "00B", year, workbook_name = "extract")
 
   return(comparison)
 }

R/process_tests_prescribing.R

@@ -9,11 +9,13 @@
 process_tests_prescribing <- function(data, year) {
   old_data <- get_existing_data_for_tests(data)
 
+  data <- rename_hscp(data)
+
   comparison <- produce_test_comparison(
     old_data = produce_source_pis_tests(old_data),
     new_data = produce_source_pis_tests(data)
   ) %>%
-    write_tests_xlsx(sheet_name = "PIS", year)
+    write_tests_xlsx(sheet_name = "PIS", year, workbook_name = "extract")
 
   return(comparison)
 }

R/process_tests_sc_ch_episodes.R

@@ -20,7 +20,7 @@ process_tests_sc_ch_episodes <- function(data) {
   )
 
   comparison %>%
-    write_tests_xlsx(sheet_name = "all_ch_episodes")
+    write_tests_xlsx(sheet_name = "all_ch_episodes", workbook_name = "lookup")
 
   return(comparison)
 }

R/process_tests_sc_client_lookup.R

@@ -16,7 +16,7 @@ process_tests_sc_client_lookup <- function(data, year) {
   )
 
   comparison %>%
-    write_tests_xlsx(sheet_name = "sc_client", year)
+    write_tests_xlsx(sheet_name = "sc_client", year, workbook_name = "lookup")
 
   return(comparison)
 }

R/process_tests_sc_demographics.R

@@ -18,7 +18,7 @@ process_tests_sc_demographics <- function(data) {
       data
     )
   ) %>%
-    write_tests_xlsx(sheet_name = "sc_demographics")
+    write_tests_xlsx(sheet_name = "sc_demographics", workbook_name = "lookup")
 
   return(comparison)
 }

R/process_tests_sds.R

@@ -9,11 +9,13 @@
 process_tests_sds <- function(data, year) {
   old_data <- get_existing_data_for_tests(data)
 
+  data <- rename_hscp(data)
+
   comparison <- produce_test_comparison(
     old_data = produce_source_sds_tests(old_data),
     new_data = produce_source_sds_tests(data)
   ) %>%
-    write_tests_xlsx(sheet_name = "sds", year)
+    write_tests_xlsx(sheet_name = "sds", year, workbook_name = "extract")
 
   return(comparison)
 }