-
Notifications
You must be signed in to change notification settings - Fork 7
/
check_rs_rsdtc_visit_ordinal_error.R
86 lines (71 loc) · 3.3 KB
/
check_rs_rsdtc_visit_ordinal_error.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 that all RS dates for INV Overall Response are duplicated or
#' earlier than last visit's (possible date entry error)
#'
#' @description This check identifies RSDTC values when RSEVAL == 'INVESTIGATOR'
#' and RSTESTCD == 'OVRLRESP' that are duplicated or earlier than last visit's.
#' Unscheduled and 'NOT DONE' visits are excluded.
#'
#' @param RS Response SDTM dataset with variables USUBJID, VISITNUM, VISIT,
#' RSDTC, RSTESTCD, RSEVAL, RSSTAT
#'
#' @return boolean value if check failed or passed with 'msg' attribute if the
#' test failed
#'
#' @export
#'
#' @author James Zhang
#'
#' @examples
#'
#' # no cases
#' RS<- data.frame(USUBJID = 101:102,
#' RSDTC=rep(c("2017-01-01T08:25", "2017-01-05T09:25",
#' "2017-01-15T10:25","2017-01-20T08:25","2017-01-25T08:25"), 2),
#' VISITNUM=rep(1:5,2),
#' VISIT=rep(c("Screening", "Cycle 1", "Cycle 2","Cycle 3","Follow-up"),2),
#' RSTESTCD="OVRLRESP",
#' RSEVAL="INVESTIGATOR",
#' RSSTAT="",
#' stringsAsFactors=FALSE)
#' check_rs_rsdtc_visit_ordinal_error(RS)
#'
#' # adding cases with earler date
#' RS$RSDTC[RS$USUBJID == 101 & RS$VISIT == "Cycle 3"] <- "2017-01-02T08:25"
#' RS$RSDTC[RS$USUBJID == 102 & RS$VISIT == "Cycle 1"] <- "2017-01-01T06:25"
#' check_rs_rsdtc_visit_ordinal_error(RS)
#'
check_rs_rsdtc_visit_ordinal_error <- function(RS){
class(RS) <- 'data.frame'
vars = c("USUBJID", "VISITNUM", "VISIT", "RSDTC", "RSTESTCD","RSEVAL","RSSTAT")
### First check that required variables exist and return a message if they don't
if (RS %lacks_any% vars) {
fail(lacks_msg(RS, vars))
### Dont run if VISITNUM is all missing
} else if (length(unique(RS[["VISITNUM"]]))<=1) {
fail("VISITNUM exists but only a single value. ")
} else {
#only keep INV overall responses not indicated as Not Done
subsetdf = subset(RS,RS$RSTESTCD=="OVRLRESP" & RS$RSEVAL=="INVESTIGATOR" & RS$RSSTAT != "NOT DONE" & !grepl("UNSCHEDU",toupper(RS$VISIT)),)
if(nrow(subsetdf)>0){
mydf2 <- dtc_dupl_early(dts = subsetdf, vars = vars,
### groupby variables used for grouping and visit.order derivation
groupby = vars[c(1)],
dtc = vars[4],
### variables used for ordering before visit.order derivation
vars[1], vars[2], vars[3], vars[4])
### Subset if Vis_order not equal Dtc_order
myout <- mydf2[!is.na(mydf2$check.flag), ]
### Different check already doing dups
myout = subset(myout,myout$check.flag != "Duplicated",)
###Print to report
### Return message if no records with RSDTC per VISITNUM
if (nrow(myout) == 0) {
pass()
### Return subset dataframe if there are records with Possible RSDTC data entry error
} else if (nrow(myout) > 0) {
rownames(myout) = NULL
fail(paste("RS has ",nrow(myout)," records with Possible RSDTC data entry error. ",sep = ""), myout)
}
} else{fail("No records when subset to overall responses by INV. ")}
}
}