From 4a277fce8ef3d7c18535142f5f5304217138d51c Mon Sep 17 00:00:00 2001 From: Jennit07 <67372904+Jennit07@users.noreply.github.com> Date: Tue, 19 Nov 2024 09:25:16 +0000 Subject: [PATCH] Clean test folder (#1021) * Update refs script * Add check_year_valid to update_refs script * Update documentation * Add description to 00_update_refs * Update wb name and paths for write_xlsx * Style code * Clean up github redundant scripts * Rename script to match function name * Update documentation * Update cost test path * write to disk only if file does not exist * Remove object * Update R/00-update_refs.R Co-authored-by: Zihao Li --------- Co-authored-by: Jennit07 Co-authored-by: Zihao Li --- NAMESPACE | 6 + R/00-update_refs.R | 136 +++++++++++++++++- R/check_year_valid.R | 55 ------- R/process_costs_rmd.R | 23 +-- ....R => process_extract_ooh_consultations.R} | 0 R/write_tests_xlsx.R | 21 ++- man/check_year_valid.Rd | 2 +- man/end_date.Rd | 14 ++ man/fy.Rd | 14 ++ man/process_extract_ooh_consultations.Rd | 2 +- man/qtr.Rd | 14 ++ run_targets_1718.R | 20 --- run_targets_1819.R | 20 --- run_targets_1920.R | 20 --- run_targets_2021.R | 20 --- run_targets_2122.R | 20 --- run_targets_2223.R | 20 --- run_targets_2324.R | 20 --- 18 files changed, 202 insertions(+), 225 deletions(-) delete mode 100644 R/check_year_valid.R rename R/{process_extract_consultations.R => process_extract_ooh_consultations.R} (100%) create mode 100644 man/end_date.Rd create mode 100644 man/fy.Rd create mode 100644 man/qtr.Rd delete mode 100644 run_targets_1718.R delete mode 100644 run_targets_1819.R delete mode 100644 run_targets_1920.R delete mode 100644 run_targets_2021.R delete mode 100644 run_targets_2122.R delete mode 100644 run_targets_2223.R delete mode 100644 run_targets_2324.R diff --git a/NAMESPACE b/NAMESPACE index 52350b38c..7bb9f5097 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,11 +1,13 @@ # Generated by roxygen2: do not edit by hand export("%>%") +export(End) export(add_deceased_flag) export(add_homelessness_date_flags) export(add_homelessness_flag) export(add_hri_variables) export(add_nsu_cohort) +export(as) export(check_year_format) export(clean_temp_data) export(clean_up_free_text) @@ -22,10 +24,13 @@ export(create_episode_file) export(create_homelessness_lookup) export(create_individual_file) export(create_service_use_cohorts) +export(date) +export(dmy) 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) @@ -156,6 +161,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) diff --git a/R/00-update_refs.R b/R/00-update_refs.R index 33022edf6..4d51a9503 100644 --- a/R/00-update_refs.R +++ b/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 as dmy +#' +end_date <- function() { + ## UPDATE ## + # Last date in reporting period + # Q1 June = 30062024 + # Q2 September = 30092024 + # Q3 December = 31122024 + # Q4 March = 31032024 + lubridate::dmy(30092024) +} + + +#' 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% c("nsu", "hhg")) { + return(FALSE) + } else if (year >= "2425" && type %in% "nsu") { + 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_Jun24" +} + + #' Latest update #' #' @description Get the date of the latest update, e.g 'Jun_2022' @@ -10,6 +116,7 @@ latest_update <- function() { "Sep_2024" } + #' Previous update #' #' @param months_ago Number of months since the previous update @@ -51,19 +158,34 @@ previous_update <- function(months_ago = 3L, override = NULL) { 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" +#' @examples +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 diff --git a/R/check_year_valid.R b/R/check_year_valid.R deleted file mode 100644 index bc92361f5..000000000 --- a/R/check_year_valid.R +++ /dev/null @@ -1,55 +0,0 @@ -#' 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% c("nsu", "hhg")) { - return(FALSE) - } else if (year >= "2425" && type %in% "nsu") { - return(FALSE) - } else if (year >= "2526" && type %in% c("ch", "hc", "sds", "at", "sparra")) { - return(FALSE) - } - - return(TRUE) -} diff --git a/R/process_costs_rmd.R b/R/process_costs_rmd.R index bca00871d..bd986fb35 100644 --- a/R/process_costs_rmd.R +++ b/R/process_costs_rmd.R @@ -23,7 +23,8 @@ process_costs_rmd <- function(file_name) { output_dir <- fs::path( get_slf_dir(), - "Tests" + "Tests", + "cost_tests" ) input_file <- get_file_path( @@ -44,13 +45,19 @@ process_costs_rmd <- function(file_name) { check_mode = "write" ) - rmarkdown::render( - input = input_file, - output_file = output_file, - output_format = "html_document", - envir = new.env(), - quiet = TRUE - ) + if (fs::file_exists(output_file)) { + # Do not write file if it already exists + output <- NULL + } else { + # If file does not exist, create it + rmarkdown::render( + input = input_file, + output_file = output_file, + output_format = "html_document", + envir = new.env(), + quiet = TRUE + ) + } if (fs::file_info(output_file)$user == Sys.getenv("USER")) { # Set the correct permissions diff --git a/R/process_extract_consultations.R b/R/process_extract_ooh_consultations.R similarity index 100% rename from R/process_extract_consultations.R rename to R/process_extract_ooh_consultations.R diff --git a/R/write_tests_xlsx.R b/R/write_tests_xlsx.R index a1b53f971..2241ce519 100644 --- a/R/write_tests_xlsx.R +++ b/R/write_tests_xlsx.R @@ -25,16 +25,12 @@ write_tests_xlsx <- function(comparison_data, )) { # Set up the workbook ---- if (workbook_name == "ep_file") { - if (is.null(year)) { - tests_workbook_name <- - stringr::str_glue(latest_update(), "_ep_file_tests") - } + tests_workbook_name <- + stringr::str_glue(latest_update(), "_{year}_ep_file_tests") } if (workbook_name == "indiv_file") { - if (is.null(year)) { - tests_workbook_name <- - stringr::str_glue(latest_update(), "_indiv_file_tests") - } + tests_workbook_name <- + stringr::str_glue(latest_update(), "_{year}_indiv_file_tests") } if (workbook_name == "lookup") { if (is.null(year)) { @@ -53,17 +49,16 @@ write_tests_xlsx <- function(comparison_data, } } if (workbook_name == "extract") { - if (is.null(year)) { - } else { - tests_workbook_name <- - stringr::str_glue(latest_update(), "_{year}_extract_tests") - } + tests_workbook_name <- + stringr::str_glue(latest_update(), "_{year}_extract_tests") } tests_workbook_path <- fs::path( get_slf_dir(), "Tests", + fy(), + qtr(), tests_workbook_name, ext = "xlsx" ) diff --git a/man/check_year_valid.Rd b/man/check_year_valid.Rd index 59960da30..7b704d2ec 100644 --- a/man/check_year_valid.Rd +++ b/man/check_year_valid.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/check_year_valid.R +% Please edit documentation in R/00-update_refs.R \name{check_year_valid} \alias{check_year_valid} \title{Check data exists for a year} diff --git a/man/end_date.Rd b/man/end_date.Rd new file mode 100644 index 000000000..9d617ac10 --- /dev/null +++ b/man/end_date.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/00-update_refs.R +\name{end_date} +\alias{end_date} +\title{End date} +\usage{ +end_date() +} +\value{ +Get the end date of the latest update period +} +\description{ +End date +} diff --git a/man/fy.Rd b/man/fy.Rd new file mode 100644 index 000000000..21c4b47f1 --- /dev/null +++ b/man/fy.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/00-update_refs.R +\name{fy} +\alias{fy} +\title{Extract latest FY from end_date} +\usage{ +fy() +} +\value{ +fy in format "2024" +} +\description{ +Extract latest FY from end_date +} diff --git a/man/process_extract_ooh_consultations.Rd b/man/process_extract_ooh_consultations.Rd index ae4265823..22159c2ed 100644 --- a/man/process_extract_ooh_consultations.Rd +++ b/man/process_extract_ooh_consultations.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/process_extract_consultations.R +% Please edit documentation in R/process_extract_ooh_consultations.R \name{process_extract_ooh_consultations} \alias{process_extract_ooh_consultations} \title{Process the GP OOH Consultations extract} diff --git a/man/qtr.Rd b/man/qtr.Rd new file mode 100644 index 000000000..79629f858 --- /dev/null +++ b/man/qtr.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/00-update_refs.R +\name{qtr} +\alias{qtr} +\title{Extract latest quarter from end_date} +\usage{ +qtr() +} +\value{ +qtr in format "Q1" +} +\description{ +Extract latest quarter from end_date +} diff --git a/run_targets_1718.R b/run_targets_1718.R deleted file mode 100644 index 488918e1d..000000000 --- a/run_targets_1718.R +++ /dev/null @@ -1,20 +0,0 @@ -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) diff --git a/run_targets_1819.R b/run_targets_1819.R deleted file mode 100644 index 7c63807e8..000000000 --- a/run_targets_1819.R +++ /dev/null @@ -1,20 +0,0 @@ -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) diff --git a/run_targets_1920.R b/run_targets_1920.R deleted file mode 100644 index d3361a34c..000000000 --- a/run_targets_1920.R +++ /dev/null @@ -1,20 +0,0 @@ -library(targets) - -Sys.setenv("CREATESLF_KEYRING_PASS" = "createslf") - -year <- "1920" - -# use targets for the process until testing episode files -tar_make_future( - # it does not recognise `contains(year)` - names = (targets::contains("1920")) -) - -# 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) diff --git a/run_targets_2021.R b/run_targets_2021.R deleted file mode 100644 index efcfaed7a..000000000 --- a/run_targets_2021.R +++ /dev/null @@ -1,20 +0,0 @@ -library(targets) - -Sys.setenv("CREATESLF_KEYRING_PASS" = "createslf") - -year <- "2021" - -# use targets for the process until testing episode files -tar_make_future( - # it does not recognise `contains(year)` - names = (targets::contains("2021")) -) - -# 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) diff --git a/run_targets_2122.R b/run_targets_2122.R deleted file mode 100644 index e92d75c7d..000000000 --- a/run_targets_2122.R +++ /dev/null @@ -1,20 +0,0 @@ -library(targets) - -Sys.setenv("CREATESLF_KEYRING_PASS" = "createslf") - -year <- "2122" - -# use targets for the process until testing episode files -tar_make_future( - # it does not recognise `contains(year)` - names = (targets::contains("2122")) -) - -# 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) diff --git a/run_targets_2223.R b/run_targets_2223.R deleted file mode 100644 index f5c93ee2f..000000000 --- a/run_targets_2223.R +++ /dev/null @@ -1,20 +0,0 @@ -library(targets) - -Sys.setenv("CREATESLF_KEYRING_PASS" = "createslf") - -year <- "2223" - -# use targets for the process until testing episode files -tar_make_future( - # it does not recognise `contains(year)` - names = (targets::contains("2223")) -) - -# 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) diff --git a/run_targets_2324.R b/run_targets_2324.R deleted file mode 100644 index 5e3885bc2..000000000 --- a/run_targets_2324.R +++ /dev/null @@ -1,20 +0,0 @@ -library(targets) - -Sys.setenv("CREATESLF_KEYRING_PASS" = "createslf") - -year <- "2324" - -# use targets for the process until testing episode files -tar_make_future( - # it does not recognise `contains(year)` - names = (targets::contains("2324")) -) - -# 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)