You signed in with another tab or window. Reload to refresh your session.You signed out in another tab or window. Reload to refresh your session.You switched accounts on another tab or window. Reload to refresh your session.Dismiss alert
###################################################### 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 platformdb_connection<- phs_db_connection(dsn="DVPROD")
# read in data - social care 2 demographicat_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 quarterpre_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 variableperson_id=glue::glue("{sending_location}-{social_care_id}"),
# Use function for creating sc send lca variablessc_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 codedtplyr::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 filereadr::write_rds(fs::path(social_care_dir, stringr::str_glue("all_at_episodes_{latest_update()}.rds")),
compress="xz"
) %>%
# save sav filehaven::write_sav(fs::path(social_care_dir, stringr::str_glue("all_at_episodes_{latest_update()}.zsav")),
compress="zsav"
)
The text was updated successfully, but these errors were encountered:
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
The text was updated successfully, but these errors were encountered: