-
Notifications
You must be signed in to change notification settings - Fork 7
/
check_pr_prlat.R
130 lines (114 loc) · 4.19 KB
/
check_pr_prlat.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 if ocular procedures/surgeries has laterality missing for CRF pages which contain the word "OCULAR" (and not "NON-OCULAR").
#'
#' @description This check assesses observations where PRCAT contains the word OCULAR and flags records with missing/inconsistent laterality
#'
#' @param PR Procedure/Surgery Dataset for Ophtho Study with variables USUBJID,
#' PRCAT, PRLAT, PRTRT, PROCCUR, PRPRESP, PRSPID (if Present),
#' PRSTDTC (if Present), PRINDC (if Present)
#'
#' @importFrom dplyr %>% filter mutate select intersect
#' @param preproc An optional company specific preprocessing script
#' @param ... Other arguments passed to methods
#'
#' @importFrom dplyr %>% filter select
#' @importFrom tidyselect any_of
#'
#' @family OPHTH
#'
#' @keywords OPHTH
#'
#'
#' @export
#'
#' @author Tim Barnett (HackR 2021 Team Eye) Monarch Shah (Added Concurrent Ocular Procedure in this check) (copied from check_cm_cmlat)
#'
#'
#' @examples
#'
#' PR <- data.frame(
#' USUBJID = 1:5,
#' PRCAT = "PRIOR OCULAR SURGERIES AND PROCEDURES",
#' PRSTDTC = 1:5,
#' PRLAT = c("Left", "","Bilateral", "", ""),
#' PRTRT = c("A", "B", "A", "B", "A"),
#' PROCCUR = c("Y", "N", "N", "Y", "Y"),
#' PRPRESP = "Y",
#' PRSPID = "FORMNAME-R:2/L:2XXXX",
#' stringsAsFactors = FALSE)
#' check_pr_prlat(PR,preproc=roche_derive_rave_row)
#'
#' PR <- data.frame(
#' USUBJID = 1:5,
#' PRCAT = "CONCURRENT OCULAR PROCEDURE",
#' PRSTDTC = 1:5,
#' PRLAT = c("Left", "LEFT","Bilateral", "RIGHT", "RIgHT"),
#' PRTRT = c("A", "B", "A", "B", "A"),
#' PROCCUR = NA,
#' PRPRESP = NA,
#' stringsAsFactors = FALSE)
#' check_pr_prlat(PR)
#'
#' PR <- data.frame(
#' USUBJID = 1:5,
#' PRCAT = "CONCURRENT OCULAR PROCEDURE",
#' PRSTDTC = 1:5,
#' PRLAT = c("Left", "LEFT","Bilateral", "RIGHT", ""),
#' PRTRT = c("A", "B", "A", "B", "A"),
#' PROCCUR = NA,
#' PRPRESP = NA,
#' stringsAsFactors = FALSE)
#' check_pr_prlat(PR)
#'
#' PR <- data.frame(
#' USUBJID = 1:5,
#' PRCAT = "CONCURRENT OCULAR PROCEDURE",
#' PRSTDTC = 1:5,
#' PRLAT = c("Left", "","Bilateral", "RIGHT", ""),
#' PRTRT = c("A", "B", "A", "B", "A"),
#' PROCCUR = c("Y", "N", "N", "Y", "Y"),
#' PRPRESP = "Y",
#' stringsAsFactors = FALSE)
#' check_pr_prlat(PR)
#'
#' PR <- data.frame(
#' USUBJID = 1:5,
#' PRCAT = c(rep("CONCURRENT NON-OCULAR PROCEDURE",3),rep("CONCURRENT OCULAR PROCEDURE",2)),
#' PRSTDTC = 1:5,
#' PRLAT = c("", "","", "RIGHT", ""),
#' PRTRT = c("A", "B", "A", "B", "A"),
#' PROCCUR = c("Y", "N", "N", "Y", "Y"),
#' PRPRESP = "Y",
#' stringsAsFactors = FALSE)
#' check_pr_prlat(PR)
#'
#'
#'
check_pr_prlat <- function(PR,preproc=identity,...) {
if (PR %lacks_any% c("USUBJID", "PRCAT", "PRLAT", "PRTRT", "PROCCUR", "PRPRESP")) {
fail(lacks_msg(PR, c("USUBJID", "PRCAT", "PRLAT", "PRTRT", "PROCCUR", "PRPRESP")))
### Dont run if relevant PRCAT not present
} else if (PR %>% filter(grepl("OCULAR", toupper(PRCAT), fixed = T) & ! grepl("NON-OCULAR", toupper(PRCAT), fixed = T)) %>%
select(PRCAT) %>% unique() %>% nrow()<1) {
fail(msg="No data with PRCAT containing the word OCULAR")
} else {
#Apply company specific preprocessing function
PR = preproc(PR,...)
perm_var <- c("PRSTDTC", "RAVE", "PRINDC")
int_var <- intersect(names(PR), perm_var)
my_select_var <- c("USUBJID", "PRCAT", int_var, "PRLAT", "PRTRT")
mydf = PR %>%
filter(grepl("OCULAR", toupper(PRCAT), fixed = T) & ! grepl("NON-OCULAR", toupper(PRCAT), fixed = T) &
((PRPRESP == "Y" & PROCCUR == "Y") | (is_sas_na(PRPRESP) & is_sas_na(PROCCUR)))) %>%
select(any_of(my_select_var)) %>%
mutate(MISFLAG = ifelse(!(toupper(PRLAT) %in% c("LEFT", "RIGHT", "BILATERAL")), 1, 0))
rownames(mydf)=NULL
mydf <- mydf %>% filter(MISFLAG == 1) %>% select(-MISFLAG)
if ((nrow(mydf) > 0 ) == FALSE) {
pass()
} else {
fail(paste0(nrow(mydf),
" record(s) with PRLAT Missing from records with PRCAT containing the word OCULAR when expected to be populated. "),
mydf )
}
}
}