Update older years to bring the data in line with our newest processes.

R/check_year_valid.R

@@ -17,6 +17,7 @@ check_year_valid <- function(
       "ch",
       "client",
       "cmh",
+      "cost_dna",
       "dd",
       "deaths",
       "dn",
@@ -34,9 +35,9 @@ check_year_valid <- function(
     )) {
   if (year <= "1415" && type %in% c("dn", "sparra")) {
     return(FALSE)
-  } else if (year <= "1516" && type %in% c("cmh", "homelessness")) {
+  } else if (year <= "1516" && type %in% c("cmh", "homelessness", "dd")) {
     return(FALSE)
-  } else if (year <= "1617" && type %in% c("ch", "hc", "sds", "at")) {
+  } else if (year <= "1617" && type %in% c("ch", "hc", "sds", "at", "client", "cost_dna")) {
     return(FALSE)
   } else if (year <= "1718" && type %in% "hhg") {
     return(FALSE)

R/create_episode_file.R

@@ -175,7 +175,53 @@
         sc_social_worker = NA,
         sc_type_of_housing = NA,
         sc_meals = NA,
-        sc_day_care = NA
+        sc_day_care = NA,
+        social_care_id = NA,
+        count_not_known = NA
+      )
+  }
+
+  if (!check_year_valid(year, type = "homelessness")) {
+    episode_file <- episode_file %>%
+      dplyr::mutate(
+        hl1_12_months_post_app = NA,
+        hl1_12_months_pre_app = NA,
+        hl1_6after_ep = NA,
+        hl1_6before_ep = NA,
+        hl1_application_ref = NA,
+        hl1_completeness = NA,
+        hl1_during_ep = NA,
+        hl1_in_fy = NA,
+        hl1_property_type = NA,
+        hl1_reason_ftm = NA,
+        hl1_sending_lca = NA
+      )
+  }
+
+  if (!check_year_valid(year, type = "dd")) {
+    episode_file <- episode_file %>%
+      dplyr::mutate(
+        cij_delay = NA,
+        dd_quality = NA,
+        dd_responsible_lca = NA,
+        delay_end_reason = NA,
+        primary_delay_reason = NA,
+        secondary_delay_reason = NA,
+      )
+  }
+
+  if (!check_year_valid(year, type = "dn")) {
+    episode_file <- episode_file %>%
+      dplyr::mutate(
+        ccm = NA,
+        totalnodncontacts = NA
+      )
+  }
+
+  if (!check_year_valid(year, type = "cost_dna")) {
+    episode_file <- episode_file %>%
+      dplyr::mutate(
+        cost_total_net_inc_dnas = NA
       )
   }
 
@@ -376,7 +422,7 @@
     dplyr::mutate(
       cost_total_net_inc_dnas = .data$cost_total_net,
       # In the Cost_Total_Net column set the cost for
       # those with attendance status 5 or 8 (CNWs and DNAs)
       cost_total_net = dplyr::if_else(
         .data$attendance_status %in% c(5L, 8L),
         0.0,
@@ -463,6 +509,11 @@
                            file_type = c("episode", "individual")) {
   cli::cli_alert_info("Join social care client function started at {Sys.time()}")
 
+  if (!check_year_valid(year, type = "client")) {
+    data_file <- data
+    return(data_file)
+  }
+
   if (file_type == "episode") {
     # Match on client variables by chi
     data_file <- data %>%

R/create_individual_file.R

@@ -78,7 +78,7 @@ create_individual_file <- function(
 
   if (!check_year_valid(year, type = c("ch", "hc", "at", "sds"))) {
     individual_file <- individual_file %>%
-      aggregate_by_chi(exclude_sc_var = TRUE)
+      aggregate_by_chi(year = year, exclude_sc_var = TRUE)
   } else {
     individual_file <- individual_file %>%
       aggregate_ch_episodes() %>%
@@ -115,6 +115,9 @@ create_individual_file <- function(
         hc_personal_hours = NA,
         hc_non_personal_hours = NA,
         hc_reablement_hours = NA,
+        hc_non_personal_hours_cost = NA,
+        hc_personal_hours_cost = NA,
+        hc_reablement_hours_cost = NA,
         at_alarms = NA,
         at_telecare = NA,
         sds_option_1 = NA,
@@ -125,10 +128,20 @@ create_individual_file <- function(
         sc_support_from_unpaid_carer = NA,
         sc_social_worker = NA,
         sc_meals = NA,
-        sc_day_care = NA
+        sc_day_care = NA,
+        sc_type_of_housing = NA,
+        count_not_known = NA,
+        sc_latest_submission = NA,
+        social_care_id = NA
       )
   }
 
+  if (!check_year_valid(year, type = "homelessness")) {
+    individual_file <- individual_file %>%
+      dplyr::mutate(hl1_in_fy = NA)
+  }
+
+
   if (anon_chi_out) {
     individual_file <- individual_file %>%
       tidyr::replace_na(list(chi = "")) %>%

R/get_boxi_extract_path.R

@@ -86,9 +86,11 @@ get_boxi_extract_path <- function(
 #'
 #' @return an [fs::path()] to a dummy file which can be used with targets.
 get_dummy_boxi_extract_path <- function() {
-  get_file_path(
+  dummy_path <- get_file_path(
     directory = get_dev_dir(),
     file_name = ".dummy",
     create = TRUE
   )
+
+  return(dummy_path)
 }

R/get_sc_lookup_paths.R

@@ -38,11 +38,18 @@ get_sc_demog_lookup_path <- function(update = latest_update(), ...) {
 #' @family social care lookup file paths
 #' @seealso [get_file_path()] for the generic function.
 get_sc_client_lookup_path <- function(year, update = latest_update(), ...) {
-  sc_client_lookup_path <- get_file_path(
-    directory = fs::path(get_slf_dir(), "Social_care", "processed_sc_client_lookup"),
-    file_name = stringr::str_glue("anon-sc_client_lookup_{year}_{update}.parquet"),
-    ...
-  )
-
-  return(sc_client_lookup_path)
+  if (!check_year_valid(year, type = "client")) {
+    return(get_dummy_boxi_extract_path())
+  } else {
+    sc_client_lookup_path <- get_file_path(
+      directory = fs::path(
+        get_slf_dir(),
+        "Social_care",
+        "processed_sc_client_lookup"
+      ),
+      file_name = stringr::str_glue("anon-sc_client_lookup_{year}_{update}.parquet"),
+      ...
+    )
+    return(sc_client_lookup_path)
+  }
 }

R/link_delayed_discharge_eps.R

@@ -14,6 +14,10 @@ link_delayed_discharge_eps <- function(
     dd_data = read_file(get_source_extract_path(year, "dd")) %>% slfhelper::get_chi()) {
   cli::cli_alert_info("Link delayed discharge to episode file function started at {Sys.time()}")
 
+  if (!check_year_valid(year, type = "dd")) {
+    episode_file <- episode_file
+    return(episode_file)
+  }
   episode_file <- episode_file %>%
     dplyr::mutate(
       # remember to revoke the cij_end_date with dummy_cij_end

R/process_lookup_homelessness.R

@@ -15,6 +15,10 @@ create_homelessness_lookup <- function(
     homelessness_data = read_file(get_source_extract_path(year, "homelessness")) %>% slfhelper::get_chi()) {
   cli::cli_alert_info("Create homelessness lookup function started at {Sys.time()}")
 
+  # Specify years available for running
+  if (year < "1617") {
+    return(NULL)
+  }
   homelessness_lookup <- homelessness_data %>%
     dplyr::distinct(.data$chi, .data$record_keydate1, .data$record_keydate2) %>%
     tidyr::drop_na(.data$chi) %>%
@@ -39,6 +43,11 @@ add_homelessness_flag <- function(data, year,
                                   lookup = create_homelessness_lookup(year)) {
   cli::cli_alert_info("Add homelessness flag function started at {Sys.time()}")
 
+  if (!check_year_valid(year, type = "homelessness")) {
+    data <- data
+    return(data)
+  }
+
   data <- data %>%
     dplyr::left_join(
       lookup %>%
@@ -65,6 +74,11 @@ add_homelessness_flag <- function(data, year,
 add_homelessness_date_flags <- function(data, year, lookup = create_homelessness_lookup(year)) {
   cli::cli_alert_info("Add homelessness date flags function started at {Sys.time()}")
 
+  if (!check_year_valid(year, type = "homelessness")) {
+    data <- data
+    return(data)
+  }
+
   lookup <- lookup %>%
     dplyr::filter(!(is.na(.data$record_keydate2))) %>%
     dplyr::rename(

R/process_lookup_sc_client.R

@@ -20,6 +20,11 @@ process_lookup_sc_client <-
              slfhelper::get_chi() %>%
              dplyr::select(c("sending_location", "social_care_id", "chi", "latest_flag")),
            write_to_disk = TRUE) {
+    # Specify years available for running
+    if (year < "1718") {
+      return(NULL)
+    }
+
     # Match to demographics lookup to get CHI
     sc_client_demographics <- data %>%
       dplyr::right_join(

R/read_file.R

@@ -29,7 +29,7 @@ read_file <- function(path, col_select = NULL, as_data_frame = TRUE, ...) {
 
   # Return an empty tibble if trying to read the dummy path
   if (path == get_dummy_boxi_extract_path()) {
-    return(tibble::tibble())
+    return(tibble::tibble(anon_chi = NA_character_))
   }
 
   ext <- fs::path_ext(path)

R/replace_sc_id_with_latest.R

@@ -7,40 +7,31 @@ replace_sc_id_with_latest <- function(data) {
   # Check for required variables
   check_variables_exist(
     data,
-    c("sending_location", "social_care_id", "chi", "period")
+    c("sending_location", "social_care_id", "chi", "latest_flag")
   )
 
   # select variables we need
   filter_data <- data %>%
     dplyr::select(
-      "sending_location", "social_care_id", "chi", "period"
+      "sending_location", "social_care_id", "chi", "latest_flag"
     ) %>%
-    dplyr::filter(!(is.na(.data$chi)))
+    dplyr::filter(!(is.na(.data$chi))) %>%
+    dplyr::distinct()
 
   change_sc_id <- filter_data %>%
-    # Sort (by sending_location, chi and period) for unique chi/sending location
-    dplyr::arrange(
-      .data$sending_location,
-      .data$chi,
-      dplyr::desc(.data$period)
-    ) %>%
-    # Find the latest sc_id for each chi/sending location by keeping latest period
-    dplyr::distinct(
-      .data$sending_location,
-      .data$chi,
-      .keep_all = TRUE
-    ) %>%
+    dplyr::filter(latest_flag == 1) %>%
     # Rename for latest sc id
     dplyr::rename(latest_sc_id = "social_care_id") %>%
-    # drop period for matching
-    dplyr::select(-"period")
+    # drop latest_flag for matching
+    dplyr::select(-"latest_flag")
 
   return_data <- change_sc_id %>%
     # Match back onto data
     dplyr::right_join(data,
       by = c("sending_location", "chi"),
       multiple = "all"
     ) %>%
+    dplyr::filter(!(is.na(period))) %>%
     # Overwrite sc id with the latest
     dplyr::mutate(
       social_care_id = dplyr::if_else(

R/write_tests_xlsx.R

@@ -96,6 +96,14 @@ write_tests_xlsx <- function(comparison_data,
 
   date_today <- stringr::str_to_lower(date_today)
 
+  sheet_name_dated <- ifelse(
+    is.null(year),
+    stringr::str_glue("{sheet_name}_{date_today}"),
+    stringr::str_glue("{year}_{sheet_name}_{date_today}")
+  )
+
+  date_today <- stringr::str_to_lower(date_today)
+
   if (is.null(year)) {
     sheet_name_dated <- stringr::str_glue("{sheet_name}_{date_today}")
   } else {

Run_SLF_Files_targets/run_targets_1415.R

@@ -0,0 +1,9 @@
+library(targets)
+
+year <- "1415"
+
+# use targets for the process until testing episode files
+tar_make_future(
+  # it does not recognise `contains(year)`
+  names = (targets::contains("1415"))
+)

Run_SLF_Files_targets/run_targets_1516.R

@@ -0,0 +1,9 @@
+library(targets)
+
+year <- "1516"
+
+# use targets for the process until testing episode files
+tar_make_future(
+  # it does not recognise `contains(year)`
+  names = (targets::contains("1516"))
+)

Run_SLF_Files_targets/run_targets_1617.R

@@ -0,0 +1,9 @@
+library(targets)
+
+year <- "1617"
+
+# use targets for the process until testing episode files
+tar_make_future(
+  # it does not recognise `contains(year)`
+  names = (targets::contains("1617"))
+)

_targets.R

@@ -19,7 +19,10 @@ tar_option_set(
   memory = "persistent" # default option
 )
 
-years_to_run <- c("1718", "1819", "1920", "2021", "2122", "2223", "2324")
+years_to_run <- c(
+  "1415", "1516", "1617", "1718", "1819", "1920",
+  "2021", "2122", "2223", "2324"
+)
 
 list(
   tar_rds(write_to_disk, TRUE),

run_targets_1718.R

@@ -0,0 +1,20 @@
+library(targets)
+
+Sys.setenv("CREATESLF_KEYRING_PASS" = "createslf")
+
+year <- "1718"
+
+# use targets for the process until testing episode files
+tar_make_future(
+  # it does not recognise `contains(year)`
+  names = (targets::contains("1718"))
+)
+
+# use targets to create individual files due to RAM limit
+library(createslf)
+
+episode_file <- arrow::read_parquet(get_slf_episode_path(year))
+
+# Run individual file
+create_individual_file(episode_file, year = year) %>%
+  process_tests_individual_file(year = year)

run_targets_1819.R

@@ -0,0 +1,20 @@
+library(targets)
+
+Sys.setenv("CREATESLF_KEYRING_PASS" = "createslf")
+
+year <- "1819"
+
+# use targets for the process until testing episode files
+tar_make_future(
+  # it does not recognise `contains(year)`
+  names = (targets::contains("1819"))
+)
+
+# use targets to create individual files due to RAM limit
+library(createslf)
+
+episode_file <- arrow::read_parquet(get_slf_episode_path(year))
+
+# Run individual file
+create_individual_file(episode_file, year = year) %>%
+  process_tests_individual_file(year = year)