-
Notifications
You must be signed in to change notification settings - Fork 7
/
check_ss_ssdtc_alive_dm.R
86 lines (75 loc) · 2.49 KB
/
check_ss_ssdtc_alive_dm.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
#' @title Check non-missing last ALIVE status date in SS is before than death date in DM
#'
#' @description This check looks for non-missing SS.SSDTC when SS.SSORRES contains 'ALIVE' and
#' Subject Status Date/Time of Assessments is greater then
#' Start Date/Time of Disposition Event(SS.SSDTC > DS.DSSTDTC)
#'
#' @param SS Subject Status SDTM dataset with variables USUBJID, SSDTC, SSORRES, SSTESTCD, VISIT
#' @param DM Demographics SDTM dataset with variables USUBJID, DTHDTC
#'
#' @return boolean value if check failed or passed with 'msg' attribute if the
#' test failed
#'
#' @export
#'
#' @importFrom dplyr left_join filter %>%
#'
#' @author Vira Vrakina
#'
#' @examples
#'
#' SS <- data.frame(
#' USUBJID = 1:5,
#' SSDTC = "2020-01-02",
#' SSTESTCD = "SURVSTAT",
#' SSORRES = c("DEAD","DEAD","ALIVE","DEAD","ALIVE"),
#' VISIT = "WEEK 4"
#' )
#'
#'
#' DM <- data.frame(
#' USUBJID = 1:5,
#' DTHDTC = "2020-01-03"
#' )
#'
#' check_ss_ssdtc_alive_dm(SS, DM)
#'
#' SS <- data.frame(
#' USUBJID = 1:5,
#' SSDTC = "2020-01-04",
#' SSTESTCD = "SURVSTAT",
#' SSORRES = c("DEAD","DEAD","ALIVE","DEAD","ALIVE"),
#' VISIT = "WEEK 4"
#' )
#'
#' DM <- data.frame(
#' USUBJID = 1:5,
#' DTHDTC = c("2020-01-04", "2020-01-05", "2020-01-03", "2020-01-04", "2020-01-05")
#' )
#'
#' check_ss_ssdtc_alive_dm(SS, DM)
#'
check_ss_ssdtc_alive_dm <- function(SS, DM) {
###First check that required variables exist and return a message if they don't
if(SS %lacks_any% c("USUBJID","SSDTC","SSORRES", "SSTESTCD", "VISIT")){
fail(lacks_msg(SS, c("USUBJID","SSDTC","SSORRES", "SSTESTCD", "VISIT")))
}else if(DM %lacks_any% c("USUBJID", "DTHDTC")){
fail(lacks_msg(DM, c("USUBJID", "DTHDTC")))
}else{
myss <- subset(SS, !is_sas_na(SS$SSDTC) & SS$SSTESTCD == 'SURVSTAT' & grepl("ALIVE", SS$SSORRES), c("USUBJID","SSDTC","SSORRES","SSTESTCD", "VISIT"))
mydm <- subset(DM, !is_sas_na(DM$DTHDTC), c("USUBJID", "DTHDTC"))
mydf <- myss %>%
left_join(mydm, by="USUBJID") %>%
filter(SSDTC > DTHDTC)
###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 ALIVE status date in SS domain later than death date in DM domain. ",sep=""),
mydf)
}
}
}