-
Notifications
You must be signed in to change notification settings - Fork 7
/
check_pr_missing_month.R
85 lines (67 loc) · 2.3 KB
/
check_pr_missing_month.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
#' @title Check for procedure dates with year and day known but month unknown
#'
#' @description This check looks for partial missing dates in PR Procedures
#' start date and end date, if end date exists. If the day of the month is
#' known, the month should be known.
#'
#' @param PR Procedures SDTM dataset with variables USUBJID, PRTRT, PRSTDTC,
#' PRENDTC (optional), PRSPID (optional)
#' @param preproc An optional company specific preprocessing script
#' @param ... Other arguments passed to methods
#'
#' @importFrom dplyr %>% filter select
#' @importFrom tidyselect any_of
#'
#' @return boolean value if check failed or passed with 'msg' attribute if the
#' test failed
#'
#' @export
#'
#' @examples
#'
#' PR <- data.frame(
#' USUBJID = 1:3,
#' PRTRT = c("Surgery Name","Procedure Name","Procedure"),
#' PRSTDTC = c("2017-01-01","2017---01","2017-01-02"),
#' PRENDTC = c("2017-02-01","2017-03-01","2017---01"),
#' PRSPID = "/F:SURG-D:12345-R:1",
#' PRCAT = "Form 1",
#' stringsAsFactors=FALSE
#' )
#'
#' check_pr_missing_month(PR)
#'
#' check_pr_missing_month(PR,preproc=roche_derive_rave_row)
#'
#' PR$PRENDTC = NULL
#' check_pr_missing_month(PR)
#'
check_pr_missing_month <- function(PR,preproc=identity,...){
###First check that required variables exist and return a message if they don't
if(PR %lacks_any% c("USUBJID", "PRTRT", "PRSTDTC")){
fail(lacks_msg(PR, c("USUBJID", "PRTRT", "PRSTDTC")))
} else{
#Apply company specific preprocessing function
PR = preproc(PR,...)
# PRENDTC is an optional variable
if (PR %lacks_any% "PRENDTC") {
mydf <- PR %>%
filter(missing_month(PRSTDTC)) %>%
select(any_of(c("USUBJID", "PRTRT", "PRSTDTC", "PRENDTC", "RAVE")))
} else {
mydf <- PR %>%
filter(missing_month(PRSTDTC) | missing_month(PRENDTC)) %>%
select(any_of(c("USUBJID", "PRTRT", "PRSTDTC", "PRENDTC", "RAVE")))
}
rownames(mydf)=NULL
###Print to report
if(nrow(mydf)==0){
pass()
### Return subset dataframe if there are records with inconsistency
}else if(nrow(mydf)>0){
fail(paste(length(unique(mydf$USUBJID)),
" patient(s) with a PR procedure date with known year and day but unknown month. ",sep=""),
mydf)
}
}
}