Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

- ask SC team as last meeting they said to look at extract date - these dont rel... #658

Closed
github-actions bot opened this issue May 15, 2023 · 2 comments
Assignees

Comments

@github-actions
Copy link

e.g. extract date later than period

Record date is the last day of the quarter

qtr_start is the first day of the quarter

replace social_care_id with latest

drop variables not needed

https://api.github.com/Public-Health-Scotland/source-linkage-files/blob/4ec0aadae5af0569118cd5ed123254dd64cad31c/_SPSS_archived/All_years/04-Social_Care/03-Alarms_Telecare_data.R#L49

#####################################################
# Social Care Alarms Telecare Data
# Author: Jennifer Thom
# Date: April 2022
# Written on RStudio Server
# Version of R - 3.6.1
# Input - Data from Social care database DVPROD
# Description - Get Alarms Telecare data
#####################################################

## load packages ##

library(dplyr)
library(lubridate)


# Set up------------------------------------------------------------------

source("All_years/04-Social_Care/00-Social_Care_functions.R")


# Read Demographic file----------------------------------------------------

sc_demographics <- haven::read_sav(fs::path(
  social_care_dir,
  paste0("sc_demographics_lookup_", latest_update()),
  ext = "zsav"
))

# Query to database -------------------------------------------------------

# set-up connection to platform
db_connection <- phs_db_connection(dsn = "DVPROD")

# read in data - social care 2 demographic
at_full_data <- tbl(
  db_connection,
  dbplyr::in_schema("social_care_2", "equipment_snapshot")
) %>%
  select(
    sending_location,
    social_care_id,
    period,
    service_type,
    service_start_date,
    service_end_date
  ) %>%
  # fix bad period (2017, 2020 & 2021)
  # TODO - ask SC team as last meeting they said to look at extract date - these dont relate.
  # e.g. extract date later than period
  mutate(
    period = if_else(period == "2017", "2017Q4", period),
    period = if_else(period == "2020", "2020Q4", period),
    period = if_else(period == "2021", "2021Q4", period)
  ) %>%
  # order
  arrange(sending_location, social_care_id) %>%
  collect()


# Data Cleaning-----------------------------------------------------

# Work out the dates for each period
# Record date is the last day of the quarter
# qtr_start is the first day of the quarter
pre_compute_record_dates <- at_full_data %>%
  distinct(period) %>%
  mutate(
    record_date = yq(period) %m+% period(6, "months") %m-% days(1),
    qtr_start = yq(period) %m+% period(3, "months")
  )

replaced_start_dates <- at_full_data %>%
  # Replace missing start dates with the start of the FY
  left_join(pre_compute_record_dates, by = "period") %>%
  dplyr::mutate(
    start_date_missing = is.na(service_start_date),
    service_start_date = if_else(
      start_date_missing,
      start_fy(year = substr(period, 1, 4), format = "alternate"),
      service_start_date
    )
  )

at_full_clean <- replaced_start_dates %>%
  # Match on demographics data (CHI, gender, DoB and postcode)
  left_join(sc_demographics, by = c("sending_location", "social_care_id")) %>%
  # rename for matching source variables
  rename(
    record_keydate1 = service_start_date,
    record_keydate2 = service_end_date
  ) %>%
  # Include source variables
  mutate(
    recid = "AT",
    smrtype = case_when(
      service_type == 1 ~ "AT-Alarm",
      service_type == 2 ~ "AT-Tele"
    ),
    # Create person id variable
    person_id = glue::glue("{sending_location}-{social_care_id}"),
    # Use function for creating sc send lca variables
    sc_send_lca = convert_sc_sl_to_lca(sending_location)
  ) %>%
  # when multiple social_care_id from sending_location for single CHI
  # replace social_care_id with latest
  group_by(sending_location, chi) %>%
  mutate(latest_sc_id = last(social_care_id)) %>%
  # count changed social_care_id
  mutate(
    changed_sc_id = !is.na(chi) & social_care_id != latest_sc_id,
    social_care_id = if_else(changed_sc_id, latest_sc_id, social_care_id)
  ) %>%
  ungroup()

# Deal with episodes which have a package across quarters.
qtr_merge <- at_full_clean %>%
  # Use lazy_dt() for faster running of code
  dtplyr::lazy_dt() %>%
  group_by(
    sending_location,
    social_care_id,
    record_keydate1,
    smrtype,
    period
  ) %>%
  # Create a count for the package number across episodes
  mutate(
    pkg_count = row_number()
  ) %>%
  # Sort prior to merging
  arrange(.by_group = TRUE) %>%
  # group for merging episodes
  group_by(
    sending_location,
    social_care_id,
    record_keydate1,
    smrtype,
    pkg_count
  ) %>%
  # merge episodes with packages across quarters
  # drop variables not needed
  summarise(
    sending_location = last(sending_location),
    social_care_id = last(social_care_id),
    sc_latest_submission = last(period),
    record_keydate1 = last(record_keydate1),
    record_keydate2 = last(record_keydate2),
    smrtype = last(smrtype),
    pkg_count = last(pkg_count),
    chi = last(chi),
    gender = last(gender),
    dob = last(dob),
    postcode = last(postcode),
    recid = last(recid),
    person_id = last(person_id),
    sc_send_lca = last(sc_send_lca)
  ) %>%
  # sort after merging
  arrange(
    sending_location,
    social_care_id,
    record_keydate1,
    smrtype,
    sc_latest_submission
  ) %>%
  # end of lazy_dt()
  as_tibble() %>%
  # Sort for running SPSS
  arrange(
    sending_location,
    social_care_id
  )


# Save outfile------------------------------------------------

qtr_merge %>%
  # save rds file
  readr::write_rds(fs::path(social_care_dir, stringr::str_glue("all_at_episodes_{latest_update()}.rds")),
    compress = "xz"
  ) %>%
  # save sav file
  haven::write_sav(fs::path(social_care_dir, stringr::str_glue("all_at_episodes_{latest_update()}.zsav")),
    compress = "zsav"
  )
@github-actions github-actions bot added the todo label May 15, 2023
@Jennit07
Copy link
Collaborator

I think this is fine and the todo comment can just be removed!

@SwiftySalmon
Copy link
Collaborator

remove to do label

@Jennit07 Jennit07 self-assigned this Sep 29, 2023
@Jennit07 Jennit07 closed this as completed Nov 7, 2023
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

2 participants