Create tests for all social care extracts (#854)

addresses #842 

Produces tests for social care `all` extracts. The data is the processed
extract taken from the social care platform containing all years worth
of data.

Still to do: 
- Add these tests into the targets pipeline. (@SwiftySalmon happy to
have a call with you to share how to do this!)

NAMESPACE

@@ -138,7 +138,10 @@ export(process_tests_mental_health)
 export(process_tests_nrs_deaths)
 export(process_tests_outpatients)
 export(process_tests_prescribing)
-export(process_tests_sc_ch_episodes)
+export(process_tests_sc_all_at_episodes)
+export(process_tests_sc_all_ch_episodes)
+export(process_tests_sc_all_hc_episodes)
+export(process_tests_sc_all_sds_episodes)
 export(process_tests_sc_client_lookup)
 export(process_tests_sc_demographics)
 export(process_tests_sds)

R/process_tests_sc_all_at_episodes.R

@@ -0,0 +1,26 @@
+#' Process Social Care Alarms Telecare all episodes tests
+#'
+#' @param data The processed Alarms Telecare all episode data produced by
+#' [process_sc_all_alarms_telecare()].
+#'
+#' @description This script takes the processed all Alarms Telecare file and produces
+#' a test comparison with the previous data.
+#'
+#' @return a [tibble][tibble::tibble-package] containing a test comparison.
+#'
+#' @export
+process_tests_sc_all_at_episodes <- function(data) {
+  comparison <- produce_test_comparison(
+    old_data = produce_sc_all_episodes_tests(
+      read_file(get_sc_at_episodes_path(update = previous_update()))
+    ),
+    new_data = produce_sc_all_episodes_tests(
+      data
+    )
+  )
+
+  comparison %>%
+    write_tests_xlsx(sheet_name = "all_at_episodes", workbook_name = "lookup")
+
+  return(comparison)
+}

R/process_tests_sc_all_ch_episodes.R

@@ -0,0 +1,26 @@
+#' Process Social Care Care Home all episodes tests
+#'
+#' @param data The processed Care Home all episode data produced by
+#' [process_extract_care_home()].
+#'
+#' @description This script takes the processed all Care Home file and produces
+#' a test comparison with the previous data.
+#'
+#' @return a [tibble][tibble::tibble-package] containing a test comparison.
+#'
+#' @export
+process_tests_sc_all_ch_episodes <- function(data) {
+  comparison <- produce_test_comparison(
+    old_data = produce_sc_all_episodes_tests(
+      read_file(get_sc_ch_episodes_path(update = previous_update()))
+    ),
+    new_data = produce_sc_all_episodes_tests(
+      data
+    )
+  )
+
+  comparison %>%
+    write_tests_xlsx(sheet_name = "all_ch_episodes", workbook_name = "lookup")
+
+  return(comparison)
+}

R/process_tests_sc_all_hc_episodes.R

@@ -0,0 +1,26 @@
+#' Process Social Care Home Care all episodes tests
+#'
+#' @param data The processed Home Care all episode data produced by
+#' [process_sc_all_home_care()].
+#'
+#' @description This script takes the processed all Home Care file and produces
+#' a test comparison with the previous data.
+#'
+#' @return a [tibble][tibble::tibble-package] containing a test comparison.
+#'
+#' @export
+process_tests_sc_all_hc_episodes <- function(data) {
+  comparison <- produce_test_comparison(
+    old_data = produce_sc_all_episodes_tests(
+      read_file(get_sc_hc_episodes_path(update = previous_update()))
+    ),
+    new_data = produce_sc_all_episodes_tests(
+      data
+    )
+  )
+
+  comparison %>%
+    write_tests_xlsx(sheet_name = "all_hc_episodes", workbook_name = "lookup")
+
+  return(comparison)
+}

R/process_tests_sc_all_sds_episodes.R

@@ -0,0 +1,26 @@
+#' Process Social Care SDS all episodes tests
+#'
+#' @param data The processed SDS all episode data produced by
+#' [process_sc_all_sds()].
+#'
+#' @description This script takes the processed all SDS file and produces
+#' a test comparison with the previous data.
+#'
+#' @return a [tibble][tibble::tibble-package] containing a test comparison.
+#'
+#' @export
+process_tests_sc_all_sds_episodes <- function(data) {
+  comparison <- produce_test_comparison(
+    old_data = produce_sc_all_episodes_tests(
+      read_file(get_sc_sds_episodes_path(update = previous_update()))
+    ),
+    new_data = produce_sc_all_episodes_tests(
+      data
+    )
+  )
+
+  comparison %>%
+    write_tests_xlsx(sheet_name = "all_sds_episodes", workbook_name = "lookup")
+
+  return(comparison)
+}

R/produce_sc_all_episodes_tests.R

@@ -0,0 +1,30 @@
+#' Social care All Episodes Tests
+#'
+#' @description Produce the test for the social care all episodes
+#'
+#' @param data new or old data for testing summary flags
+#'
+#' @return a dataframe with a count of each flag.
+#'
+#' @family social care test functions
+produce_sc_all_episodes_tests <- function(data) {
+  data %>%
+    # create test flags
+    create_demog_test_flags() %>%
+    dplyr::mutate(
+      n_missing_sending_loc = dplyr::if_else(
+        is.na(.data$sending_location),
+        1L,
+        0L
+      ),
+      n_missing_sc_id = dplyr::if_else(
+        is_missing(.data$social_care_id),
+        1L,
+        0L
+      )
+    ) %>%
+    # keep variables for comparison
+    dplyr::select(c("valid_chi":dplyr::last_col())) %>%
+    # use function to sum new test flags
+    calculate_measures(measure = "sum")
+}

R/write_tests_xlsx.R

@@ -22,13 +22,15 @@ write_tests_xlsx <- function(comparison_data,
                              workbook_name = c("ep_file", "indiv_file", "lookup", "extract")) {
   # Set up the workbook ----
 
-  tests_workbook_name <- dplyr::case_when(
-    workbook_name == "ep_file" ~ stringr::str_glue(latest_update(), "_ep_file_tests"),
-    workbook_name == "indiv_file" ~ stringr::str_glue(latest_update(), "_indiv_file_tests"),
-    workbook_name == "lookup" ~ stringr::str_glue(latest_update(), "_lookups_tests"),
-    workbook_name == "extract" ~ stringr::str_glue(latest_update(), "_{year}_extract_tests")
-  )
-
+  if (missing(year) & workbook_name == "lookup") {
+    tests_workbook_name <- stringr::str_glue(latest_update(), "_lookups_tests")
+  } else {
+    tests_workbook_name <- dplyr::case_when(
+      workbook_name == "ep_file" ~ stringr::str_glue(latest_update(), "_ep_file_tests"),
+      workbook_name == "indiv_file" ~ stringr::str_glue(latest_update(), "_indiv_file_tests"),
+      workbook_name == "extract" ~ stringr::str_glue(latest_update(), "_{year}_extract_tests")
+    )
+  }
 
   tests_workbook_path <- fs::path(
     get_slf_dir(),

_targets.R

@@ -134,6 +134,10 @@ list(
     ),
     priority = 0.5
   ),
+  tar_target(
+    tests_sc_all_at,
+    process_tests_sc_all_at_episodes(all_at)
+  ),
   tar_target(
     all_home_care_extract,
     read_sc_all_home_care(),
@@ -151,6 +155,10 @@ list(
     ),
     priority = 0.5
   ),
+  tar_target(
+    tests_sc_all_home_care,
+    process_tests_sc_all_hc_episodes(all_home_care)
+  ),
   tar_target(
     all_care_home_extract,
     read_sc_all_care_home(),
@@ -173,7 +181,7 @@ list(
   ),
   tar_target(
     tests_all_care_home,
-    process_tests_sc_ch_episodes(all_care_home)
+    process_tests_sc_all_ch_episodes(all_care_home)
   ),
   tar_target(
     all_sds_extract,
@@ -192,6 +200,10 @@ list(
     ),
     priority = 0.5
   ),
+  tar_target(
+    tests_sc_all_sds,
+    process_tests_sc_all_sds_episodes(all_sds)
+  ),
   tar_map(
     list(year = years_to_run),
     tar_rds(