-
Notifications
You must be signed in to change notification settings - Fork 7
/
check_ss_ssdtc_dead_ds.R
129 lines (114 loc) · 4.16 KB
/
check_ss_ssdtc_dead_ds.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
#' @title Check non-missing DEAD status date in SS and non-missing according DS record with death date
#' where status date is greater or equal to death date
#'
#' @description This check looks for missing death date in DS dataset
#' if there is DEAD status date in SS dataset or
#' if Subject Status Date/Time of Assessments is less than
#' Start Date/Time of Disposition Event(SS.SSDTC < DS.DSSTDTC)
#'
#' @param SS Subject Status SDTM dataset with variables USUBJID, SSDTC, SSSTRESC, VISIT
#' @param DS Disposition SDTM dataset with variables USUBJID, DSSTDTC, DSDECOD, DSCAT
#' @param preproc An optional company specific preprocessing script
#' @param ... Other arguments passed to methods
#'
#' @return boolean value if check failed or passed with 'msg' attribute if the
#' test failed
#'
#' @export
#'
#' @importFrom dplyr left_join filter %>% rename
#' @importFrom tidyselect any_of
#'
#' @author Vira Vrakina
#'
#' @examples
#'
#' SS <- data.frame(
#' USUBJID = 1:5,
#' SSDTC = "2020-01-02",
#' SSSTRESC = c("DEAD","DEAD","ALIVE","DEAD","ALIVE"),
#' VISIT = "FOLLOW-UP",
#' SSSPID = "FORMNAME-R:13/L:13XXXX"
#' )
#'
#' DS <- data.frame(
#' USUBJID = 1:5,
#' DSSTDTC = c("2020-01-02","2020-01-02", "2020-01-01", "2020-01-03", "2020-01-01"),
#' DSDECOD = c(rep('DEATH', 5)),
#' DSSPID = "FORMNAME-R:13/L:13XXXX",
#' DSCAT = c("OTHER EVENT", rep("DISPOSITION EVENT", 4))
#' )
#'
#' check_ss_ssdtc_dead_ds(SS, DS)
#' check_ss_ssdtc_dead_ds(SS, DS, preproc=roche_derive_rave_row)
#'
#'
#' SS <- data.frame(
#' USUBJID = 1:5,
#' SSDTC = "2020-01-02",
#' SSSTRESC = c( rep("DEAD", 5)),
#' VISIT = "FOLLOW-UP",
#' SSSPID = "FORMNAME-R:13/L:13XXXX"
#' )
#'
#' DS <- data.frame(
#' USUBJID = 1:5,
#' DSSTDTC = c("2020-01-02","2020-01-02", "2020-01-01", "2020-01-03", "2020-01-01"),
#' DSDECOD = c(rep('DEATH', 5)),
#' DSSPID = "FORMNAME-R:13/L:13XXXX",
#' DSCAT = c(rep("DISPOSITION EVENT", 5))
#' )
#'
#' check_ss_ssdtc_dead_ds(SS, DS)
#' check_ss_ssdtc_dead_ds(SS, DS, preproc=roche_derive_rave_row)
#'
#'
#' SS <- data.frame(
#' USUBJID = 1:5,
#' SSDTC = "2020-01-02",
#' SSSTRESC = c(rep("DEAD", 5)),
#' VISIT = "FOLLOW-UP",
#' SSSPID = "FORMNAME-R:13/L:13XXXX"
#' )
#'
#' DS <- data.frame(
#' USUBJID = 1:5,
#' DSSTDTC = 2,
#' DSDECOD = c(rep('DEATH', 5)),
#' DSSPID = "FORMNAME-R:13/L:13XXXX",
#' DSCAT = c(rep("DISPOSITION EVENT", 5))
#' )
#'
#' check_ss_ssdtc_dead_ds(SS, DS)
#'
check_ss_ssdtc_dead_ds <- function(SS, DS, preproc=identity,...) {
###First check that required variables exist and return a message if they don't
if(SS %lacks_any% c("USUBJID","SSDTC","SSSTRESC", "VISIT")){
fail(lacks_msg(SS, c("USUBJID","SSDTC","SSSTRESC", "VISIT")))
}else if(DS %lacks_any% c("USUBJID", "DSSTDTC", "DSDECOD", "DSCAT")){
fail(lacks_msg(DS, c("USUBJID", "DSSTDTC", "DSDECOD", "DSCAT")))
}else{
#Apply company specific preprocessing function
DS = preproc(DS,...)
SS = preproc(SS,...)
myss <- subset(SS, !is_sas_na(SS$SSDTC) & toupper(SS$SSSTRESC) == 'DEAD') %>%
select(any_of(c("USUBJID","SSDTC","SSSTRESC", "VISIT","RAVE")))
myds <- subset(DS, !is_sas_na(DS$DSSTDTC) & toupper(DS$DSDECOD) == 'DEATH' & toupper(DS$DSCAT) == "DISPOSITION EVENT") %>%
select(any_of(c("USUBJID", "DSSTDTC", "DSDECOD", "DSCAT","RAVE")))
if("RAVE" %in% names(myds)){myds = myds %>% rename(DS_RAVE=RAVE)}
if("RAVE" %in% names(myss)){myss = myss %>% rename(SS_RAVE=RAVE)}
mydf <- myss %>%
left_join(myds, by="USUBJID") %>%
filter(is_sas_na(DSSTDTC) | SSDTC < DSSTDTC)
###Print to report
### Return message if no records
if(nrow(mydf)==0 ){
pass()
### Return subset dataframe if there are records where SS.SSDTC < DM.DTHDTC
}else if(nrow(mydf)>0){
fail(paste(length(unique(mydf$USUBJID)),
" patient(s) with death information in SS domain but no death information in DS domain or date with DEAD status in SS dataset is less than death date in DS dataset. ",sep=""),
mydf)
}
}
}