December 2024

.github/workflows/R-CMD-check.yaml

@@ -17,7 +17,7 @@ jobs:
     strategy:
       fail-fast: false
       matrix:
-        r_version: ['4.0.2', '4.1.2', 'release']
+        r_version: ['4.1.2', 'release']
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}

NAMESPACE

@@ -1,12 +1,12 @@
 # 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)
 export(add_nsu_cohort)
 export(check_year_format)
+export(clean_temp_data)
 export(clean_up_free_text)
 export(compute_mid_year_age)
 export(convert_ca_to_lca)
@@ -21,10 +21,12 @@ export(create_episode_file)
 export(create_homelessness_lookup)
 export(create_individual_file)
 export(create_service_use_cohorts)
+export(end_date)
 export(end_fy)
 export(end_fy_quarter)
 export(end_next_fy_quarter)
 export(find_latest_file)
+export(fy)
 export(fy_interval)
 export(get_boxi_extract_path)
 export(get_ch_costs_path)
@@ -89,7 +91,6 @@ 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)
@@ -156,6 +157,7 @@ export(produce_episode_file_tests)
 export(produce_sc_sandpit_tests)
 export(produce_source_extract_tests)
 export(produce_test_comparison)
+export(qtr)
 export(read_dev_slf_file)
 export(read_extract_acute)
 export(read_extract_ae)
@@ -178,12 +180,14 @@ export(read_sc_all_alarms_telecare)
 export(read_sc_all_care_home)
 export(read_sc_all_home_care)
 export(read_sc_all_sds)
+export(read_temp_data)
 export(rename_hscp)
 export(setup_keyring)
 export(start_fy)
 export(start_fy_quarter)
 export(start_next_fy_quarter)
 export(write_file)
+export(write_temp_data)
 export(years_to_run)
 importFrom(data.table,.N)
 importFrom(data.table,.SD)

NEWS.md

@@ -1,4 +1,12 @@
-# September 2024 Update - Unreleased 
+# December 2024 Update - released 10-Dec-24
+* 24/25 files have been updated, containing data up to September 2024.
+* 17/18 - 23/24 files have been updated.
+* Homelessness completeness flag is now available in 23/24 files.
+* Substance misuse flag updated.
+* Mid-2023 & Mid-2022 population estimates for Scotland have been updated.
+* Mid-2022 Small Area Population Estimates for 2011 Data Zones have been updated.
+
+# September 2024 Update - released 13-Sep-24
 * New 24/25 files created
 * New NSU cohort for 23/24 available
 * New SPARRA scores calculated from April 24/25
@@ -75,7 +83,7 @@
   * Homelessness Flags.
 * Bug fixes: 
   * Blank `datazone` in A&E. This has been fixed and was due to PC8 postcode format matching onto SLF pc lookup. 
   * Large increase in preventable beddays. This was caused due to an SPSS vs R logic difference. Uses SPSS logic which 
     brings the difference down to `3.3%`. 
   * Issue with `locality` which showed `locality` in each row instead of its true `locality`. This has now been fixed. 
   * Duplicated CHI in the individual file. The issue was identified when trying to include HRIs. This has now been corrected. 
@@ -94,7 +102,7 @@
 * Removal of `keydate1_dateformat` and `keydate2_dateformat`.
 * `dd_responsible_lca` – This variable now uses CA2019 codes instead of the 2-digit ‘old’ LCA code.
 * Preventable beddays - not able to calculate these correctly. * Death fixes not included.
 * Variables not ordered in R like they used to be in SPSS.
 * End of HHG.
 * New variable `ch_postcode`.
 * rename of variables `cost_total_net_incdnas`, `ooh_outcome.1`, `ooh_outcome.2`, `ooh_outcome.3`, `ooh_outcome.4`, `totalnodncontacts`. 
@@ -155,7 +163,7 @@
 * Fixed a bug where CH costs was not referring to end of year. 
   * e.g. 2018 costs relates to 2017/18
 * The changes to Homelessness described in the March update have been properly implemented.
 * We now use [`{haven}`](https://haven.tidyverse.org/news/index.html) to compress the SPSS files which compresses them better than SPSS does 🤷
 ♂️
 * `cij_marker` is now a numeric instead of a string which changes empty strings to missing instead of blank using sysmis.
   * Check code of the form `cij_marker = "x"`. `x` now needs to be a numeric.

Pre_processing_scripts/write_anon_chi_files.R

@@ -0,0 +1,70 @@
+################################################################################
+# Name of file -  Write_anon_chi_files.R
+#
+# Original Authors - Jennifer Thom, Zihao Li
+# Original Date - July 2024
+# Written/run on - R Posit
+# Version of R - 4.1.2
+#
+# Description: Run this script in stages to convert chi to anon chi and save files.
+#              By default this is set up to take the delayed discharges file
+#              convert the chi to anon_chi and save to disk. Important for
+#              ensuring we do not save chi anywhere on disk.
+#
+################################################################################
+
+## Stage 1 - Setup environment
+#-------------------------------------------------------------------------------
+
+# Set up directory
+source_dir <- "/conf/hscdiip/SLF_Extracts/Delayed_Discharges"
+
+# Specify type of files e.g parquet, rds, csv
+pattern <- ".parquet"
+cat(stringr::str_glue("Looking in '{source_dir}' for parquet files."))
+
+# List all files in the directory
+parquet_files <- list.files(source_dir, pattern = ".parquet", full.names = TRUE)
+print(stringr::str_glue("Found {length(parquet_files)} parquet files to process."))
+
+# Create a function to read variable names and check if CHI is in the file
+is_chi_in_file <- function(filename) {
+  data <- arrow::read_parquet(filename, nrow = 5)
+  return(grepl("chi", names(data)) %>% any())
+}
+
+
+# Stage 2 - In each file, convert chi to anon_chi and save to disk
+#-------------------------------------------------------------------------------
+
+# create a loop for converting to anon chi in all listed files
+for (data_file in parquet_files) {
+  # specify new name and new file path
+  save_file_path <- file.path(source_dir, paste0("anon-", basename(data_file)))
+  chi_in_file <- is_chi_in_file(data_file)
+
+  # If chi is in the file, convert to anon_chi
+  if (chi_in_file) {
+    read_file(data_file) %>%
+      slfhelper::get_anon_chi() %>%
+      write_file(save_file_path)
+
+    cat("Replaced chi with anon chi:", data_file, "to", save_file_path, "\n")
+  } else {
+    read_file(data_file) %>%
+      write_file(save_file_path)
+    cat("renamed file with anon chi:", data_file, "to", save_file_path, "\n")
+  }
+}
+
+
+# Stage 3 - Remove files with CHI
+#-------------------------------------------------------------------------------
+
+# Create a loop for removing the old files with CHI
+for (data_file in parquet_files) {
+  file.remove(data_file)
+  cat("Removed chi files:", data_file, "in", source_dir, "\n")
+}
+
+# End of Script #

R/00-update_refs.R

@@ -1,3 +1,109 @@
+################################################################################
+# # Name of file -  00-update_refs.R
+# Original Authors - Jennifer Thom, Zihao Li
+# Original Date - August 2021
+# Update - Oct 2024
+#
+# Written/run on - RStudio Server
+# Version of R - 4.1.2
+#
+# Description - Use this script to update references needed for the SLF update.
+#
+# Manual changes needed to the following Essential Functions:
+#       # End_date
+#       # Check_year_valid
+#       # Delayed_discharges_period
+#       # Latest_update
+#
+################################################################################
+
+#' End date
+#'
+#' @return Get the end date of the latest update period
+#' @export
+#'
+end_date <- function() {
+  ## UPDATE ##
+  # Specify update by indicating end of quarter date
+  # Q1 June = 30062024
+  # Q2 September = 30092024
+  # Q3 December = 31122024
+  # Q4 March = 31032024
+  lubridate::dmy(31122024)
+}
+
+
+#' Check data exists for a year
+#'
+#' @description  Check there is data available for a given year
+#' as some extracts are year dependent. E.g Homelessness
+#' is only available from 2016/17 onwards.
+#'
+#' @param year Financial year
+#' @param type name of extract
+#'
+#' @return A logical TRUE/FALSE
+check_year_valid <- function(
+    year,
+    type = c(
+      "acute",
+      "ae",
+      "at",
+      "ch",
+      "client",
+      "cmh",
+      "cost_dna",
+      "dd",
+      "deaths",
+      "dn",
+      "gpooh",
+      "hc",
+      "homelessness",
+      "hhg",
+      "maternity",
+      "mh",
+      "nsu",
+      "outpatients",
+      "pis",
+      "sds",
+      "sparra"
+    )) {
+  if (year <= "1415" && type %in% c("dn", "sparra")) {
+    return(FALSE)
+  } else if (year <= "1516" && type %in% c("cmh", "homelessness", "dd")) {
+    return(FALSE)
+  } 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)
+  } else if (year >= "2122" && type %in% c("cmh", "dn")) {
+    return(FALSE)
+  } else if (year >= "2324" && type %in% "hhg") {
+    return(FALSE)
+  } else if (year >= "2425" && type %in% c("nsu", "sds")) {
+    return(FALSE)
+  } else if (year >= "2526" && type %in% c("ch", "hc", "sds", "at", "sparra")) {
+    return(FALSE)
+  }
+
+  return(TRUE)
+}
+
+
+#' Delayed Discharge period
+#'
+#' @description Get the period for Delayed Discharge
+#'
+#' @return The period for the Delayed Discharge file
+#' as MMMYY_MMMYY
+#' @export
+#'
+#' @family initialisation
+get_dd_period <- function() {
+  "Jul16_Sep24"
+}
+
+
 #' Latest update
 #'
 #' @description Get the date of the latest update, e.g 'Jun_2022'
@@ -7,9 +113,10 @@
 #'
 #' @family initialisation
 latest_update <- function() {
-  "Sep_2024"
+  "Dec_2024"
 }
 
+
 #' Previous update
 #'
 #' @param months_ago Number of months since the previous update
@@ -34,11 +141,11 @@
 
   latest_update_date <- lubridate::my(latest_update())
 
   previous_update_year <- lubridate::year(
     latest_update_date - lubridate::period(months_ago, "months")
   )
 
   previous_update_month <- lubridate::month(
     latest_update_date - lubridate::period(months_ago, "months"),
     label = TRUE,
     abbr = TRUE
@@ -51,19 +158,33 @@
   return(previous_update)
 }
 
-#' Delayed Discharge period
+
+#' Extract latest FY from end_date
 #'
-#' @description Get the period for Delayed Discharge
+#' @return fy in format "2024"
+#' @export
 #'
-#' @return The period for the Delayed Discharge file
-#' as MMMYY_MMMYY
+fy <- function() {
+  # Latest FY
+  fy <- phsmethods::extract_fin_year(end_date()) %>% substr(1, 4)
+}
+
+
+#' Extract latest quarter from end_date
+#'
+#' @return qtr in format "Q1"
 #' @export
 #'
-#' @family initialisation
-get_dd_period <- function() {
-  "Jul16_Jun24"
+qtr <- function() {
+  # Latest Quarter
+  qtr <- lubridate::quarter(end_date(), fiscal_start = 4)
+
+  qtr <- stringr::str_glue("Q{qtr}")
+
+  return(qtr)
 }
 
+
 #' The year list for slf to update
 #'
 #' @description Get the vector of years to update slf