R/check_ae_aeacn_ds_disctx_covid.R

In sdtmchecks: Data Quality Checks for Study Data Tabulation Model (SDTM) Datasets

#' @title Check for COVID-19 AE with DRUG WITHDRAWN action without "ADVERSE EVENT" for DS Trt Discon
#'
#' @description This checks for a COVID-19 AE reported with Action Taken 
#' (AEACN*==DRUG WITHDRAWN) but without a corresponding DS record indicating 
#' DS.DSDECOD with "ADVERSE EVENT" on any Treatment Discontinuation 
#' form. This relies on DSSPID with the string "DISCTX" when DSCAT == 
#' "DISPOSITION EVENT" to select Treatment Discontinuation records in DS, 
#' as DSSCAT typically includes a text string referring to specific study
#' drug(s).
#'
#' @param AE Adverse Events SDTM dataset with variables USUBJID, AETERM, AEDECOD, 
#' AESTDTC, AEACNx
#' @param DS Disposition SDTM dataset with variables USUBJID, DSSPID, DSCAT, DSDECOD
#' @param covid_terms A length >=1 vector of AE terms identifying COVID-19 (case does not matter)
#'
#' @return boolean value if check returns 0 obs, otherwise return subset dataframe.
#'
#' @export
#'
#' @author Sarwan Singh
#' 
#' @family COVID
#' 
#' @keywords COVID
#'
#' @examples
#' 
#' AE <- data.frame(
#'     STUDYID = 1,
#'     USUBJID = c(1,2,3,1,2,3),
#'     AESTDTC = '2020-05-05',
#'     AETERM  = c("abc Covid-19", "covid TEST POSITIVE",rep("other AE",4)),
#'     AEDECOD = c("COVID-19", "CORONAVIRUS POSITIVE", rep("OTHER AE",4)),
#'     AEACN = c("DRUG WITHDRAWN", rep("DOSE NOT CHANGED",5)),
#'     AESPID = "FORMNAME-R:13/L:13XXXX",
#'     stringsAsFactors = FALSE
#' )
#'
#' DS <- data.frame(
#'  USUBJID = c(1,1,2,3,4),
#'  DSSPID  = 'XXX-DISCTX-XXX',
#'  DSCAT   = "DISPOSITION EVENT",
#'  DSDECOD = "OTHER REASON",
#'  DSSEQ = c(1,2,1,1,1),
#'  stringsAsFactors = FALSE
#' )
#'
#' # expect fail
#' check_ae_aeacn_ds_disctx_covid(AE, DS)
#'
#' 
#' AE2 <- data.frame( 
#'     AEACN1 =  rep(NA, nrow(AE)),
#'     AEACN2 = c("DRUG WITHDRAWN", rep("DOSE NOT CHANGED", nrow(AE)-1)),
#'     AEACN3 = c("DRUG WITHDRAWN", rep("DOSE NOT CHANGED", nrow(AE)-1)),
#'     AEACN4 = "",
#'     stringsAsFactors = FALSE
#' )
#' AE2 <- cbind(AE, AE2) 
#' AE2$AEACN <- "MULTIPLE" 
#' 
#' # expect fail
#' check_ae_aeacn_ds_disctx_covid(AE2, DS)
#' 
#' DS[1, "DSDECOD"] <- 'ADVERSE EVENT'
#' # this passes, one form with DSDECOD = "ADVERSE EVENT"
#' ## NOTE: This may be a false negative if study-specific data collection 
#' ##       requires >1 record with DSDECOD = "ADVERSE EVENT" and not just one record
#' check_ae_aeacn_ds_disctx_covid(AE2, DS)
#'
#' # expect pass
#' check_ae_aeacn_ds_disctx_covid(AE, DS)
#' 
#'
#' # non-required variable is missing
#' DS$DSSEQ <- NULL
#' check_ae_aeacn_ds_disctx_covid(AE, DS)
#' 
#' # required variable is missing 
#' DS$DSSPID <- NULL
#' check_ae_aeacn_ds_disctx_covid(AE, DS)
#' 
#' 

check_ae_aeacn_ds_disctx_covid <- function(AE,DS,covid_terms=c("COVID-19", "CORONAVIRUS POSITIVE")) {

    if(is.null(covid_terms)|
       (!is.null(covid_terms) & !is.character(covid_terms))|
       (!is.null(covid_terms) & is.character(covid_terms) & length(covid_terms)<1)|
       (!is.null(covid_terms) & is.character(covid_terms) & length(covid_terms)>=1 & all(is_sas_na(covid_terms)))
    ){
       
        fail("Check not run, did not detect COVID-19 preferred terms.  Character vector of terms expected.") 
        
    } else if( AE %lacks_any% c("USUBJID", "AETERM", "AEDECOD", "AESTDTC", "AEACN")){

        fail(lacks_msg(AE, c("USUBJID", "AETERM", "AEDECOD", "AESTDTC", "AEACN")))

    } else if( DS %lacks_any% c("USUBJID", "DSSPID", "DSCAT", "DSDECOD")){

        fail(lacks_msg(DS, c("USUBJID", "DSSPID", "DSCAT", "DSDECOD")))

    } else{
        
        #let used know terms used
        if(identical(covid_terms,c("COVID-19", "CORONAVIRUS POSITIVE"))){
            outmsg=paste("Default terms used for identifying Covid AEs:",paste(covid_terms,collapse=","))
        }else{
            outmsg=""
        }

        # keep COVID-19 AEs on which we want to check action taken with treatment
        ae_covid <- AE %>% 
            filter(toupper(AEDECOD) %in% toupper(covid_terms))

        # keep columns that are needed
        ae0 <- subset(ae_covid,
                      select = c("USUBJID", "AEDECOD", "AESTDTC", "AEACN",
                                 grep("AEACN[0-9]", names(AE), value=TRUE)))


        # find how many AEACNx variables are in AE
        aeacnvars <- grep("AEACN[0-9]", names(ae0), value=TRUE)

        #create a where condition for AE based on count of AEACNx
        whrcond <- paste("AEACN=='DRUG WITHDRAWN'")
        for (i in aeacnvars) {
            whrcond <- paste(whrcond, " | ", i, "=='DRUG WITHDRAWN'", sep="")
        }

        # loop through each AEACNx and keep DRUG WITHDRAWN AEs
        ae1 <- subset(ae0,
                      eval(parse(text = whrcond)) )

        # keep records with discontinuation treatment due to AE
        ds0 <- subset(DS,
                      DSCAT == "DISPOSITION EVENT" & grepl("DISCTX", DSSPID) & DSDECOD == "ADVERSE EVENT",
                      select = c("USUBJID", "DSDECOD"))

        # merge AE and DS
        finout <- merge(x = ae1, y = ds0,
                        by= "USUBJID",
                        all.x = TRUE)

        # keep if only in AE and not found in DS
        mydf <- subset(finout,
                       is_sas_na(DSDECOD),
                       select = -c(DSDECOD)
        )

        # Drop AEACN if its multiple
        if ("AEACN" %in% names(AE) & any(AE$AEACN=="MULTIPLE")) {
            mydf$AEACN=NULL
        }

        rownames(mydf)=NULL

        ### Return message if no inconsistency between AE and DS
        if (nrow(mydf)==0) {
            pass()

            ### Return subset dataframe if there are records with inconsistency
        } else if (nrow(mydf)>0) {

            return(fail(paste(length(unique(mydf$USUBJID)),
                              " patient(s) with COVID-19 AE indicating drug withdrawn but no Treatment Discon form indicating AE. ",
                              outmsg
                              
                              , sep=""), mydf))

        } #end else if mydf>0
    }  # end else if all required vars present
} # end function