DO NOT MERGE - Bespoke work for Moray - Forres and Lossiemouth

Custom Boundary SOP.md

@@ -0,0 +1,25 @@
+# Custom Boundaries SOP
+
+## Requirements
+
+-  A set of boundaries that are coherent with Intermediate Zones - This means the custom boundaries must be at one Intermediate Zone in size and **must** be made up of complete Intermediate Zones.
+-  Generally, we will only do one per partnership (i.e. no multiple custom boundaries for the same partnership!) per year (possibly per release).
+-  The localities team has capacity
+   - Team members' other work
+   - We will usually only work on one custom profile at a time.
+   - We will not work on a custom profile around the time we are producing a 'main' release.
+
+## Process
+
+1.  Get the new lookups in order.
+2.  Create a new data folder and update variables in a handful of places to reflect this.
+3.  Run the MSG code in the Unscheduled Care folder to get MSG data at IZ-level.
+4.  Run the `Unscheduled Care 1` script to produce the data files needed.
+5.  Run the `General Health 1` script to produce the data files needed.
+6.  Run the full indicators as usual.
+
+## Notes
+
+- Some data has to be re-extracted from the underlying databases, in these cases the data will be more recent (and likely slightly different) to the data in the 'main' profiles for the same HSCP.
+- Some data is not available at the Intermediate Zone level, therefore it is not possible for us to (reasonably) reproduce this for a custom boudary.
+- Some ScotPho data is only released as the indicator at IZ-level, therefore it is not possible for us to properly calculate the indicator for a custom boundary. For these statistics, we will simply take the mean of the values at IZ-level, and will set the confidence interval to be the same as the value.

General Health/2. General Health SLF Data.R

@@ -99,7 +99,9 @@ ltc_data <- left_join(ltc_agg, slf_pops)
 
 #### SAVE DATA ####
 
-saveRDS(ltc_data, file = paste0(
-  lp_path, "General Health/DATA ",
-  ext_year, "/LTC_from_SLF.RDS"
-))
+arrow::write_parquet(
+  ltc_data,
+  paste0(lp_path, "General Health/DATA ", ext_year, "/LTC_from_SLF_Moray_custom.parquet"),
+  version = "latest",
+  compression = "zstd"
+)

General Health/3. General Health Outputs.R

@@ -143,7 +143,9 @@ check_missing_data_scotpho(adp_presc)
 
 
 # Long-term conditions
-ltc <- readRDS(paste0(lp_path, "General Health/DATA ", ext_year, "/LTC_from_SLF.RDS"))
+ltc <- arrow::read_parquet(
+  paste0(lp_path, "General Health/DATA ", ext_year, "/LTC_from_SLF_Moray_custom.parquet")
+)
 
 ltc <- dplyr::rename(ltc,
   "Arthritis" = "arth", "Asthma" = "asthma", "Atrial fibrillation" = "atrialfib", "Cancer" = "cancer",

Master RMarkdown Document & Render Code/Locality Profiles Render Code.R

@@ -6,6 +6,7 @@ library(tidyverse)
 library(knitr)
 library(markdown)
 library(rmarkdown)
+library(fs)
 
 rm(list = ls())
 
@@ -18,9 +19,12 @@ lp_path <- "/conf/LIST_analytics/West Hub/02 - Scaled Up Work/RMarkdown/Locality
 # Source in functions code
 source("Master RMarkdown Document & Render Code/Global Script.R")
 
+# Source custom localities function to overwrite the standard
+source("Master RMarkdown Document & Render Code/overwrite_with_custom_functions.R")
+
 ## Specify HSCP here
 ## NOTE - make sure that the formatting of the partnership's name matches the lookup
-HSCP <- "Angus"
+HSCP <- "Moray"
 
 # Below creates locality list of all the localities in a chosen HSCP
 lookup <- read_in_localities()
@@ -32,6 +36,9 @@ locality_list <- lookup |>
   filter(hscp2019name == HSCP) |>
   pull(hscp_locality)
 
+# We don't want to create a profile doc for 'other areas'
+locality_list <- locality_list[locality_list != "Other areas"]
+
 
 ## Loop to create the profiles for all the localities in the list
 

Master RMarkdown Document & Render Code/overwrite_with_custom_functions.R

@@ -0,0 +1,104 @@
+read_in_localities <- function(dz_level = FALSE) {
+  data <- arrow::read_parquet(
+    fs::path(
+      "/conf/LIST_analytics/West Hub/02 - Scaled Up Work/RMarkdown/Locality Profiles/",
+      "custom_lookups/forres_and_lossiemouth_april_2022.parquet"
+    )
+  )
+
+  if (!dz_level) {
+    data <- data |>
+      dplyr::distinct(hscp_locality, hscp2019name, hscp2019, hb2019name, hb2019)
+  }
+
+  return(data)
+}
+
+read_in_iz <- function(dz_all = FALSE) {
+  iz_lookup <- arrow::read_parquet(
+    fs::path(lp_path, "custom_lookups/forres_and_lossiemouth_iz_april_2022.parquet")
+  )
+
+  if (dz_all) {
+    all_iz <- readr::read_csv(
+      file = fs::path(
+        "/conf/linkage/output/lookups/Unicode/Geography",
+        "DataZone2011/Datazone2011lookup.csv"
+      ),
+      col_types = "c",
+      col_select = c(
+        "datazone2011",
+        "intzone2011" = "IZ2011_Code",
+        "intzone2011name" = "IZ2011_Name"
+      ),
+      lazy = TRUE
+    )
+
+    iz_lookup <- iz_lookup |>
+      dplyr::full_join(
+        all_iz,
+        by = dplyr::join_by(intzone2011, intzone2011name)
+      ) |>
+      dplyr::left_join(
+        read_in_localities(dz_level = TRUE),
+        by = dplyr::join_by(datazone2011)
+      ) |>
+      dplyr::mutate(
+        hscp_locality = dplyr::if_else(is.na(hscp_locality.y), hscp_locality.x, hscp_locality.y),
+        .keep = "unused"
+      )
+  }
+
+  return(iz_lookup)
+}
+
+
+# Aggregate and calculate confidence interval
+summarise_iz_to_locality <- function(data, iz_lookup = read_in_iz(dz_all = FALSE)) {
+  iz_data <- data |>
+    inner_join(iz_lookup, by = c("area_code" = "intzone2011"))
+
+  if (anyNA(iz_data$numerator)) {
+    locality_data <- iz_data |>
+      group_by(indicator, year, period, area_name = hscp_locality, definition, data_source) |>
+      summarise(
+        measure = mean(measure),
+        area_type = "HSC locality",
+        .groups = "drop"
+      )
+  } else {
+    locality_data <- iz_data |>
+      mutate(weighted_measure = numerator * measure / 100000) %>%
+      group_by(indicator, year, period, area_name = hscp_locality, definition, data_source) |>
+      summarise(
+        numerator = sum(numerator),
+        denominator = sum(numerator / measure * 100000), # Adjust for per 100,000
+        measure = sum(weighted_measure) / sum(numerator) * 100000, # Adjust for per 100,000
+        se = sqrt(sum(numerator * (measure - lower_confidence_interval)^2 / (denominator - 1)) +
+          sum(numerator * (upper_confidence_interval - measure)^2 / (denominator - 1))),
+        lower_confidence_interval = measure - 1.96 * se,
+        upper_confidence_interval = measure + 1.96 * se,
+        area_type = "HSC locality",
+        .groups = "drop"
+      ) |>
+      select(!denominator, !se)
+  }
+
+  new_data <- data |>
+    filter(area_type %in% c("HSC locality", "Scotland", "HSC partnership", "Health board")) |>
+    bind_rows(locality_data)
+
+  return(new_data)
+}
+
+clean_scotpho_dat <- function(data) {
+  data %>%
+    summarise_iz_to_locality() |>
+    filter(area_type != "Council area" & area_type != "Intermediate zone") %>%
+    mutate(area_name = gsub("&", "and", area_name)) %>%
+    mutate(area_name = if_else(area_name == "Renfrewshire West", "West Renfrewshire", area_name)) %>%
+    mutate(
+      area_type = if_else(area_type == "HSC partnership", "HSCP", area_type),
+      area_type = if_else(area_type == "HSC locality", "Locality", area_type)
+    )
+}