September 2024 update

.github/actions/spelling/expect.txt

@@ -6,6 +6,7 @@ admtype
 ADPE
 adtf
 alstr
+anomymous
 arrivalmode
 arth
 atlassian
@@ -40,6 +41,7 @@ CNWs
 codecov
 Comhairle
 commhosp
+communicty
 congen
 copd
 costinc
@@ -53,6 +55,7 @@ customise
 cvd
 dataframe
 datamart
+datas
 datazone
 datediff
 dateformat
@@ -169,8 +172,8 @@ lubridate
 magrittr
 markdownguide
 Matern
-Mcbride
-mcmahon
+mcnicol
+megan
 microsoft
 MIU
 MMMYY
@@ -203,6 +206,7 @@ parkinsons
 patflow
 pattype
 PCEC
+pcs
 PERTH
 PHIBCS
 phs
@@ -215,13 +219,15 @@ PLICS
 popluation
 Posix
 postcodes
+Postcodesio
 PPAs
 prac
 praccode
 ptypes
 purrr
 quickstart
 rankdir
+rbindlist
 rcmdcheck
 rdd
 rdname
@@ -232,13 +238,13 @@ readr
 readxl
 reasonwait
 recid
+recordlinkage
 refailure
 reflectoring
 refsource
 reftype
 relaint
 renviron
-returnsthe
 rlang
 rmarkdown
 Rnw

DESCRIPTION

@@ -3,12 +3,8 @@ Title: Create the Source Linkage Files
 Version: 0.0.0.9000
 Authors@R: c(
     person("Public Health Scotland", , , "[email protected]", role = c("cre", "cph")),
+    person("Megan", "McNicol", , "[email protected]", role = "aut"),
     person("Jennifer", "Thom", , "[email protected]", role = "aut"),
-    person("James", "McMahon", , "[email protected]", role = "aut",
-           comment = c(ORCID = "0000-0002-5380-2029")),
-    person("Catherine", "Holland", , "[email protected]", role = "aut",
-           comment = c(ORCID = "0000-0002-3259-5745")),
-    person("Bateman", "McBride", , "[email protected]", role = "aut"),
     person("Zihao", "Li", , "[email protected]", role = "aut",
            comment = c(ORCID = "0000-0002-5178-2124"))
   )
@@ -25,25 +21,19 @@ Imports:
     data.table (>= 1.14.6),
     dbplyr (>= 2.3.1),
     dplyr (>= 1.1.1),
-    dtplyr (>= 1.3.0),
     fs (>= 1.6.1),
-    fst (>= 0.9.8),
     future (>= 1.33.0),
     future.callr (>= 0.8.1),
-    glue (>= 1.6.2),
-    haven (>= 2.5.2),
     hms (>= 1.1.0),
     janitor (>= 2.2.0),
     keyring (>= 1.3.0),
     lubridate (>= 1.9.2),
     magrittr (>= 2.0.3),
     odbc (>= 1.3.1),
-    openssl (>= 2.0.5),
     openxlsx (>= 4.2.5),
     phsmethods (>= 0.2.2),
     phsopendata (>= 0.0.1.0),
     purrr (>= 1.0.1),
-    qs (>= 0.25.5),
     R.utils (>= 2.12.2),
     readr (>= 2.1.0),
     rlang (>= 1.1.0),
@@ -73,5 +63,4 @@ Encoding: UTF-8
 Language: en-GB
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
-
+RoxygenNote: 7.3.2

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export("%>%")
+export(add_deceased_flag)
 export(add_homelessness_date_flags)
 export(add_homelessness_flag)
 export(add_hri_variables)
@@ -25,9 +26,9 @@ export(end_fy_quarter)
 export(end_next_fy_quarter)
 export(find_latest_file)
 export(fy_interval)
-export(get_all_slf_deaths_lookup_path)
 export(get_boxi_extract_path)
 export(get_ch_costs_path)
+export(get_combined_slf_deaths_lookup_path)
 export(get_dd_path)
 export(get_dd_period)
 export(get_demographic_cohorts_path)
@@ -88,11 +89,11 @@ export(midpoint_fy)
 export(next_fy)
 export(phs_db_connection)
 export(previous_update)
+export(process_combined_deaths_lookup)
 export(process_costs_ch_rmd)
 export(process_costs_dn_rmd)
 export(process_costs_gp_ooh_rmd)
 export(process_costs_hc_rmd)
-export(process_deaths_lookup)
 export(process_extract_acute)
 export(process_extract_ae)
 export(process_extract_alarms_telecare)
@@ -115,6 +116,7 @@ export(process_lookup_ltc)
 export(process_lookup_postcode)
 export(process_lookup_sc_client)
 export(process_lookup_sc_demographics)
+export(process_refined_death)
 export(process_sc_all_alarms_telecare)
 export(process_sc_all_care_home)
 export(process_sc_all_home_care)
@@ -182,6 +184,7 @@ export(start_fy)
 export(start_fy_quarter)
 export(start_next_fy_quarter)
 export(write_file)
+export(years_to_run)
 importFrom(data.table,.N)
 importFrom(data.table,.SD)
 importFrom(magrittr,"%>%")

NEWS.md

@@ -1,4 +1,18 @@
-# June 2024 Update - Unreleased
+# September 2024 Update - Unreleased 
+* New 24/25 files created
+* New NSU cohort for 23/24 available
+* New SPARRA scores calculated from April 24/25
+* Death dates attached to activity after death flag 
+* Care home methodology updated
+* New cup marker for Acute and GP OOH
+* Bug fix:
+    * person id for SDS and client
+    * DD data: 
+      * The variable `cij_delay` is only attached to the `recid = DD` rows, not all the rows in the CIJ as we'd expect.
+      * The `cij_delay` variable is showing as 1 against the Delay records (NA otherwise) - We expect this to be `TRUE/FALSE` to match the other flags.
+      * The `cij_ppa` variable isn't attaching to the `recid = DD` rows.
+
+# June 2024 Update - released 06-Jun-24
 * Update of 2017/18 onwards to include bug fixes within the files.
 * Removal of extra variable caused by the LTCs not matching properly.
 * New NRS mid-2022 population estimates.

R/00-update_refs.R

@@ -7,7 +7,7 @@
 #'
 #' @family initialisation
 latest_update <- function() {
-  "Jun_2024"
+  "Sep_2024"
 }
 
 #' Previous update
@@ -61,18 +61,24 @@ previous_update <- function(months_ago = 3L, override = NULL) {
 #'
 #' @family initialisation
 get_dd_period <- function() {
-  "Jul16_Mar24"
+  "Jul16_Jun24"
 }
 
-#' The latest financial year for Cost uplift setting
+#' The year list for slf to update
 #'
-#' @description Get the latest year for cost uplift
+#' @description Get the vector of years to update slf
 #'
-#' @return The financial year format
+#' @return The vector of financial years
 #'
 #' @export
 #'
 #' @family initialisation
-latest_cost_year <- function() {
-  "2223"
+years_to_run <- function() {
+  fy_start_2digit <- 17
+  fy_end_2digit <- 24
+  years_to_run <- paste0(
+    fy_start_2digit:fy_end_2digit,
+    (fy_start_2digit + 1):(fy_end_2digit + 1)
+  )
+  return(years_to_run)
 }

R/add_activity_after_death_flag.R

@@ -11,8 +11,10 @@
 add_activity_after_death_flag <- function(
     data,
     year,
-    deaths_data = read_file(get_all_slf_deaths_lookup_path()) %>%
+    deaths_data = read_file(get_combined_slf_deaths_lookup_path()) %>%
       slfhelper::get_chi()) {
+  cli::cli_alert_info("Add activity after death flag function started at {Sys.time()}")
+
   # to skip warnings no visible binding for global variable ‘.’
   . <- NULL
 
@@ -24,7 +26,7 @@ add_activity_after_death_flag <- function(
       by = "chi",
       suffix = c("", "_boxi")
     ) %>%
-    dplyr::filter(.data$deceased == TRUE | .data$deceased_boxi == TRUE) %>%
+    dplyr::filter(.data$deceased == TRUE) %>%
     dplyr::distinct()
 
 
@@ -70,31 +72,28 @@ add_activity_after_death_flag <- function(
     ))
 
 
-  # Check and print error message for records which already are TRUE for the deceased variable in the episode file, but this doesn't match the
-  # BOXI deceased variable
-  check_deceased_match <- flag_data %>%
-    dplyr::filter(.data$deceased != .data$deceased_boxi)
-
-  if (nrow(check_deceased_match) != 0) {
-    warning("There were records in the episode file which have a deceased variable which does not match the BOXI NRS deceased variable")
-  }
-
-
   # Fill in date of death if missing in the episode file but available in BOXI lookup, due to historic dates of death not being carried
   # over from previous financial years
   flag_data <- flag_data %>%
     dplyr::filter(.data$activity_after_death == 1) %>%
     # Remove temporary flag variables used to create activity after death flag and fill in missing death_date
-    dplyr::select(.data$year, .data$chi, .data$record_keydate1, .data$record_keydate2, .data$activity_after_death) %>%
+    dplyr::select(.data$year, .data$chi, .data$record_keydate1, .data$record_keydate2, .data$activity_after_death, .data$death_date_boxi) %>%
     dplyr::distinct()
 
   # Match activity after death flag back to episode file
   final_data <- data %>%
     dplyr::left_join(
       flag_data,
+      # TODO: this join_by is not 100% accurate. Consider use ep_file_row_id to join
       by = c("year", "chi", "record_keydate1", "record_keydate2"),
       na_matches = "never"
-    )
+    ) %>%
+    dplyr::mutate(death_date = lubridate::as_date(ifelse(is.na(death_date) & !(is.na(death_date_boxi)),
+      death_date_boxi, death_date
+    ))) %>%
+    dplyr::select(-death_date_boxi) %>%
+    dplyr::distinct()
+
 
 
   return(final_data)
@@ -118,19 +117,19 @@ add_activity_after_death_flag <- function(
 #'
 #'
 # Read data------------------------------------------------
-process_deaths_lookup <- function(update = latest_update(),
-                                  write_to_disk = TRUE, ...) {
-  all_boxi_deaths <- read_file(get_slf_deaths_lookup_path("1415")) %>%
-    rbind(read_file(get_slf_deaths_lookup_path("1516"))) %>%
-    rbind(read_file(get_slf_deaths_lookup_path("1617"))) %>%
-    rbind(read_file(get_slf_deaths_lookup_path("1718"))) %>%
-    rbind(read_file(get_slf_deaths_lookup_path("1819"))) %>%
-    rbind(read_file(get_slf_deaths_lookup_path("1920"))) %>%
-    rbind(read_file(get_slf_deaths_lookup_path("2021"))) %>%
-    rbind(read_file(get_slf_deaths_lookup_path("2122"))) %>%
-    rbind(read_file(get_slf_deaths_lookup_path("2223"))) %>%
-    rbind(read_file(get_slf_deaths_lookup_path("2324"))) %>%
-    # TODO: make this automated to pick up files starting with name "get_slf_deaths_lookup_path"
+
+process_combined_deaths_lookup <- function(update = latest_update(),
+                                           write_to_disk = TRUE, ...) {
+  dir_folder <- "/conf/hscdiip/SLF_Extracts/Deaths"
+  file_names <- list.files(dir_folder,
+    pattern = "^anon-slf_deaths_lookup_.*parquet",
+    full.names = TRUE
+  )
+
+  # read all year specific deaths lookups and bind them together
+  all_boxi_deaths <- lapply(file_names, arrow::read_parquet) %>%
+    data.table::rbindlist() %>%
+    # convert to chi for processing
     slfhelper::get_chi() %>%
     # Remove rows with missing or blank CHI number - could also use na.omit?
     # na.omit(all_boxi_deaths)
@@ -177,9 +176,7 @@ process_deaths_lookup <- function(update = latest_update(),
   if (write_to_disk) {
     write_file(
       all_boxi_deaths,
-      fs::path(get_slf_dir(), "Deaths",
-        file_name = stringr::str_glue("anon-all_slf_deaths_lookup_{update}.parquet")
-      )
+      get_combined_slf_deaths_lookup_path()
     )
   }
 

R/add_deceased_flag.R

@@ -0,0 +1,40 @@
+#' Create the SLF Deaths lookup
+#'
+#' @description Currently this just uses the NRS death dates 'as is', with no
+#' corrections or modifications, it is expected that this will be expanded to
+#' use the CHI deaths extract from IT as well as taking into account data in
+#' the episode file to assess the validity of a death date.
+#'
+#' @param year The year to process, in FY format.
+#' @param nrs_deaths_data NRS deaths data.
+#' @param chi_deaths_data IT CHI deaths data.
+#' @param write_to_disk (optional) Should the data be written to disk default is
+#' `TRUE` i.e. write the data to disk.
+#'
+#' @return a [tibble][tibble::tibble-package] containing the episode file
+#' @export
+add_deceased_flag <- function(
+    year,
+    refined_death = read_file(get_combined_slf_deaths_lookup_path()) %>% slfhelper::get_chi(),
+    write_to_disk = TRUE) {
+  # create slf deaths lookup
+
+  dplyr::mutate(
+    death_date = dplyr::if_else(is.na(.data$record_keydate1),
+      .data$death_date_chi, .data$record_keydate1
+    ),
+    deceased = TRUE,
+    .keep = "unused"
+  ) %>%
+    # save anon chi on disk
+    slfhelper::get_anon_chi()
+
+  if (write_to_disk) {
+    write_file(
+      slf_deaths_lookup,
+      get_slf_deaths_lookup_path(year, check_mode = "write")
+    )
+  }
+
+  return(slf_deaths_lookup)
+}

R/add_nsu_cohort.R

@@ -13,6 +13,8 @@ add_nsu_cohort <- function(
     data,
     year,
     nsu_cohort = read_file(get_nsu_path(year)) %>% slfhelper::get_chi()) {
+  cli::cli_alert_info("Add NSU cohort function started at {Sys.time()}")
+
   year_param <- year
 
   if (!check_year_valid(year, "nsu")) {

R/add_ppa_flag.R

@@ -8,6 +8,8 @@
 #' @return A data frame to use as a lookup of PPAs
 #' @family episode_file
 add_ppa_flag <- function(data) {
+  cli::cli_alert_info("Add PPA flag function started at {Sys.time()}")
+
   check_variables_exist(
     data,
     variables = c(