Skip to content

Commit

Permalink
ta med rand for 1år
Browse files Browse the repository at this point in the history
  • Loading branch information
skkrist committed Jan 16, 2024
1 parent b808f66 commit 7f7bd19
Show file tree
Hide file tree
Showing 2 changed files with 101 additions and 57 deletions.
46 changes: 26 additions & 20 deletions R/getData.R
Original file line number Diff line number Diff line change
Expand Up @@ -835,21 +835,6 @@ getBaseregProsFollowup1 <- function(registryName,
pros.FORLOPSTYPE,
pros.DATO_PROS,
basereg.HOYDE,
basereg.VEKT,
basereg.HYPERTONI,
basereg.DIABETES,
basereg.HJERTESVIKT,
basereg.TIA_SLAG,
basereg.KARSYKDOM,
basereg.HJERTEFEIL,
basereg.OSAS_KOLS,
basereg.KARDIOMYOPATI,
basereg.PACEMAKER,
basereg.EJEKFRAK,
basereg.DEBUT_ARYT_AAR,
basereg.EHRA_SYMPT,
mce.PATIENT_ID,
mce.MCETYPE,
mce.HAS_FOLLOWUP,
Expand All @@ -863,9 +848,7 @@ getBaseregProsFollowup1 <- function(registryName,
patientlist.SSNSUBTYPE
FROM pros
LEFT JOIN basereg ON
pros.MCEID = basereg.MCEID AND
pros.CENTREID = basereg.CENTREID
LEFT JOIN mce ON
pros.MCEID = mce.MCEID AND
pros.CENTREID = mce.CENTREID
Expand Down Expand Up @@ -932,18 +915,38 @@ getBaseregProsFollowup1 <- function(registryName,



query_rand12 <- "SELECT MCEID,
FOLLOWUP_PARENT_TYPE,
DATO_RAND12,
RAND_1,
RAND_2A,
RAND_2B,
RAND_3A,
RAND_3B,
RAND_4A,
RAND_4B,
RAND_5,
RAND_6A,
RAND_6B,
RAND_6C,
RAND_7
FROM rand12
WHERE COMPLETE = 1
AND (FOLLOWUP_PARENT_TYPE = 9)"


if (singleRow) {
msg <- "Query single row data for 1-year followup"
query_followup <- paste0(query_followup, "\nLIMIT\n 1;")
query_basePros <- paste0(query_basePros, "\nLIMIT\n 1;")
query_proms <- paste0(query_proms, "\nLIMIT\n 1;")
} else {
query_rand12 <- paste0(query_rand12, "\nLIMIT\n 1;")
} else {
msg <- "Query data for 1-year followup"
query_followup <- paste0(query_followup, ";")
query_basePros <- paste0(query_basePros, ";")
query_proms <- paste0(query_proms, ";")
query_rand12 <- paste0(query_rand12, ";")
}

if ("session" %in% names(list(...))) {
Expand All @@ -952,17 +955,20 @@ getBaseregProsFollowup1 <- function(registryName,
d_baseregPat <- rapbase::loadRegData(registryName, query_basePros)
d_followup <- rapbase::loadRegData(registryName , query_followup)
d_proms <- rapbase::loadRegData(registryName , query_proms)
d_rand12 <- rapbase::loadRegData(registryName , query_rand12)
# nocov end
} else {
d_baseregPat <- rapbase::loadRegData(registryName, query_basePros)
d_followup <- rapbase::loadRegData(registryName , query_followup)
d_proms <- rapbase::loadRegData(registryName , query_proms)
d_rand12 <- rapbase::loadRegData(registryName , query_rand12)
}


list(d_baseregPat = d_baseregPat,
d_followup = d_followup,
d_proms = d_proms)
d_proms = d_proms,
d_rand12 = d_rand12)

}

Expand Down
112 changes: 75 additions & 37 deletions R/getPrepData.R
Original file line number Diff line number Diff line change
Expand Up @@ -672,6 +672,7 @@ getBaseregProsFollowup1Data <- function(registryName,
d_baseregPat <- d$d_baseregPat
d_followup <- d$d_followup
d_proms <- d$d_proms
d_rand12 <- d$d_rand12



Expand All @@ -692,9 +693,14 @@ getBaseregProsFollowup1Data <- function(registryName,
"PROMS_EXPIRY_DATE" = "EXPIRY_DATE") %>%
dplyr::mutate(eprom_sendt_1aar = "ja")

d_rand12 %<>%
dplyr::rename("MCEID_FOLLOWUP" = "MCEID")


names(d_followup) <- tolower(names(d_followup))
names(d_proms) <- tolower(names(d_proms))
names(d_baseregPat) <- tolower(names(d_baseregPat))
names(d_rand12) <- tolower(names(d_rand12))



Expand All @@ -711,7 +717,10 @@ getBaseregProsFollowup1Data <- function(registryName,
d_ablanor <- d_baseregPat %>%
dplyr::left_join(.,
followup_data,
by = c("mceid", "centreid", "patient_id"))
by = c("mceid", "centreid", "patient_id")) %>%
dplyr::left_join(.,
d_rand12,
by = "mceid_followup")

# Nyeste prosedyredato som har eprom:
nyeste_eprom_bestilling <- lubridate::date(max(
Expand Down Expand Up @@ -739,6 +748,7 @@ getBaseregProsFollowup1Data <- function(registryName,
# KRITERIER FOR UTSENDING
# KRITERIE 1. Alder. Under 16 på prosedyretidspunktet.
ablanor::utlede_alder() %>%
ablanor::utlede_aldersklasse() %>%
dplyr::mutate(kriterie_alder = ifelse(test = alder >= 16,
yes = "ja",
no = "nei")) %>%
Expand Down Expand Up @@ -797,49 +807,23 @@ getBaseregProsFollowup1Data <- function(registryName,


# Tidsvariabler for besvart followup
aar_followup_1aar = as.ordered(lubridate::year(followup1_dato_followup)),
maaned_nr_followup_1aar = as.ordered(
sprintf(fmt = "%02d", lubridate::month(followup1_dato_followup))),
maaned_followup_1aar = ifelse(
test = is.na(aar_followup_1aar) | is.na(maaned_nr_followup_1aar),
yes = NA,
no = paste0(aar_followup_1aar, "-", maaned_nr_followup_1aar)),



aar_followup_1aar = as.ordered(
x = lubridate::year(followup1_dato_followup)),

# Tidsvariabler for opprettet followup
aar_followup_tscreated_1aar = as.ordered(lubridate::year(followup1_tscreated)),
maaned_nr_followup_tscreated_1aar = as.ordered(sprintf(fmt = "%02d",
lubridate::month(followup1_tscreated))),
maaned_followup_tscreated_1aar = ifelse(
test = is.na(aar_followup_tscreated_1aar) | is.na(maaned_nr_followup_tscreated_1aar),
yes = NA,
no = paste0(aar_followup_tscreated_1aar, "-", maaned_nr_followup_tscreated_1aar)),


aar_followup_tscreated_1aar = as.ordered(
x = lubridate::year(followup1_tscreated)),

# Tidsvariabler for bestilt followup
aar_proms_tssendt_1aar = as.ordered(lubridate::year(proms_tssendt)),
maaned_nr_proms_tssendt_1aar = as.ordered(sprintf(fmt = "%02d",
lubridate::month(proms_tssendt))),
maaned_proms_tssendt_1aar = ifelse(
test = is.na(aar_proms_tssendt_1aar) | is.na(maaned_nr_proms_tssendt_1aar),
yes = NA,
no = paste0(aar_proms_tssendt_1aar, "-", maaned_nr_proms_tssendt_1aar)),


aar_proms_tssendt_1aar = as.ordered(
x = lubridate::year(proms_tssendt)),

dg_pros_opprettet = as.numeric(difftime(
followup1_tscreated,
dato_pros,
units = "days"
))
units = "days"))
) %>%
dplyr::select(-maaned_nr_prosedyre,
-maaned_nr_followup_tscreated_1aar,
-maaned_nr_proms_tssendt_1aar,
-maaned_nr_followup_1aar) %>%
dplyr::select(-maaned_nr_prosedyre) %>%
dplyr::arrange(mceid) %>%

dplyr::mutate(
Expand All @@ -859,8 +843,6 @@ getBaseregProsFollowup1Data <- function(registryName,
is.na(eprom_sendt_1aar))~
"teknisk problem",



TRUE ~ "nei"),

eprom_datagrunnlag_1aar = factor(
Expand Down Expand Up @@ -971,6 +953,62 @@ getBaseregProsFollowup1Data <- function(registryName,
)




# RYDDE:
d_ablanor %<>%
dplyr::select(
# Pasient og prosedyre
centreid, mceid, mceid_followup, patient_id,
forlopstype,
dato_pros, aar_prosedyre, maaned_prosedyre,
gender, alder, aldersklasse,

# Datagrunnlag for eprom og svarprosent
eprom_datagrunnlag_1aar,
eprom_besvart,
proms_expiry_date,

# Dersom besvart, her er svarene. Merk at gamle rand12 kan være
# besvart manuelt.
followup1_q1:followup1_q7_other_specify,
rand_1:rand_7,

# Variabler for å undersøke kriterier for utendelse av eprom nærmere

# fra hemit
proms_expiry_date, reminder_date,
proms_status, form_order_status_error_code,
proms_tssendt, aar_proms_tssendt_1aar,

# eprom opprettet
has_followup,
registration_type,
eprom_opprettet_1aar,
followup1_tscreated, aar_followup_tscreated_1aar,
followup1_complete, followup1_incomplete_reason,

eprom_sendt_1aar,

# Eprom utfylt og mottatt
followup1_dato_followup, aar_followup_1aar,

# Kriterier opprettelse av eprom
dato_followup_teoretisk,
versjon_1_5_eller_mer,
eprom_kjente_feil_1aar,
dg_pros_opprettet,
deceased, deceased_date,
ssn_type, ssnsubtype,
antall_pros, dg_til_neste,
kriterie_alder, kriterie_norsk, kriterie_levende_1aar,
kriterie_nyeste_1aar,
kriterie_alle_1aar)





if(singleRow == TRUE) {
# Return first row only
d_ablanor %>% dplyr::filter(dplyr::row_number() == 1)
Expand Down

0 comments on commit 7f7bd19

Please sign in to comment.