Nothing
################################################################################
## The function getSubjSex.
##
## History:
## -----------------------------------------------------------------------------
## Date Programmer Note
## ---------- -------------------- ------------------------------------------
## 2020-12-11 Bo Larsen Initial version
################################################################################
#' Extract the set of animals of the specified sex - or just add the sex of each
#' animal.
#'
#' Returns a data table with the set of animals included in the
#' \code{animalList} of the sex specified in the \code{sexFilter}.\cr
#' If the \code{sexFilter} is empty (null, na or empty string) - all rows from
#' \code{animalList} are returned with the an additional populated SEX column.
#'
#' The sex value is decided from the DM.SEX variable.\cr
#' The comparison of DM.SEX with the given value(s) in \code{sexFilter} is done
#' case-insensitive.
#'
#' If input parameter \code{inclUncertain=TRUE}, uncertain animals are included
#' in the output set. These uncertain situations are identified and reported (in
#' column UNCERTAIN_MSG):
#' \itemize{
#' \item The DM.SEX value is empty or invalid (not CT value - CDISC codelist
#' SEX - case insensitive comparison)
#' }
#' The same checks are performed and reported in column NOT_VALID_MSG if
#' \code{sexFilter} is empty and \code{noFilterReportUncertain=TRUE}.
#'
#' @param dbToken Mandatory\cr
#' Token for the open database connection (see \code{\link{initEnvironment}}).
#' @param animalList Mandatory, data.table.\cr
#' A table with the list of animals to process.\cr
#' The table must include at least columns named 'STUDYID' and 'USUBJID'.
#' @param sexFilter Optional, character.\cr
#' The sex value criterion to be used for filtering of the list of animals.\cr
#' It can be a single string, a vector or a list of multiple strings.
#' @param inclUncertain Mandatory, boolean.\cr
#' Indicates whether animals for which the sex cannot be confidently identified
#' shall be included or not in the output data table.
#' @param noFilterReportUncertain Mandatory, boolean.\cr
#' Only relevant if the \code{sexFilter} is empty.\cr
#' Indicates if the reason should be included if the sex cannot be confidently
#' decided for an animal.
#'
#' @return The function returns a data.table with columns:
#' \itemize{
#' \item STUDYID (character)
#' \item Additional columns contained in the \code{animalList} table
#' \item SEX (character)
#' \item UNCERTAIN_MSG (character)\cr
#' Included when parameter \code{inclUncertain=TRUE}.\cr
#' In case the sex cannot be confidently matched during the filtering of data,
#' the column contains an indication of the reason.\cr
#' Is NA for rows where SEX can be confidently matched.\cr
#' A non-empty UNCERTAIN_MSG value generated by this function is merged with
#' non-empty UNCERTAIN_MSG values which may exist in the input set of animals
#' specified in \code{animalList} - separated by '|'.
#' \item NOT_VALID_MSG (character)\cr
#' Included when parameter \code{noFilterReportUncertain=TRUE}.\cr
#' In case the sex cannot be confidently decided, the column contains an
#' indication of the reason.\cr
#' Is NA for rows where sex can be confidently decided.\cr
#' A non-empty NOT_VALID_MSG value generated by this function is merged with
#' non-empty NOT_VALID_MSG values which may exist in the input set of animals
#' \code{animalList} - separated by '|'.
#'}
#'
#' @export
#'
#' @examples
#' \dontrun{
#' getSubjSex(myDbToken, controlAnimals, 'M')
#' }
getSubjSex<-function(dbToken,
animalList,
sexFilter = NULL,
inclUncertain = FALSE,
noFilterReportUncertain = TRUE
) {
# Verify input parameter
if (!data.table::is.data.table(animalList)) {
stop('Input parameter animalList must have assigned a data table ')
}
if (is.null(sexFilter) | isTRUE(is.na(sexFilter)) | isTRUE(sexFilter==''))
execFilter <- FALSE
else
execFilter <- TRUE
if (execFilter & !(inclUncertain %in% c(TRUE,FALSE))) {
stop("Parameter inclUncertain must be either TRUE or FALSE")
}
if (!execFilter & !(noFilterReportUncertain %in% c(TRUE,FALSE))) {
stop("Parameter noFilterReportUncertain must be either TRUE or FALSE")
}
# Extract set of on all potential control animals for list of studyid values
# included in the input table of animals
# Join t DM to get SEX values
# - ensure all empty SEX values are returned as NA
animalListSEX <-
genericQuery(dbToken,
"select dm.studyid
,dm.usubjid
,case sex
when '' then null
else sex
end as SEX
from dm
join (select distinct studyid, setcd
from tx
where txparmcd = 'TCNTRL'
and studyid in (:1)) tx
on dm.studyid = tx.studyid
and dm.setcd = tx.setcd",
unique(animalList[,c('STUDYID')]))
# Check if a message column for uncertainties shall be included
msgCol =''
if (execFilter & inclUncertain)
msgCol = 'UNCERTAIN_MSG'
else if (!execFilter & noFilterReportUncertain)
msgCol = 'NOT_VALID_MSG'
if (msgCol != '') {
# Check SEX value for uncertainty for each extracted row.
# Get values of codelist SEX from CDISC CT
ctSEX <- getCTCodListValues(dbToken, "SEX")
# Verify if SEX is within the SEX code list
animalListSEX[, MSG := ifelse(toupper(trimws(SEX)) %in% ctSEX,
as.character(NA),
'SEX: DM.SEX does not contain a valid CT value')]
# Rename MSG col to correct name
data.table::setnames(animalListSEX, 'MSG' ,msgCol)
}
if (execFilter) {
# Execute filtering
# - extract the rows matching the specified sex
if (inclUncertain)
# Include uncertain rows
foundAnimals <- animalListSEX[toupper(trimws(SEX)) %in% toupper(trimws(sexFilter)) | ! is.na(UNCERTAIN_MSG) ]
else
# Do not include uncertain rows
foundAnimals <- animalListSEX[toupper(trimws(SEX)) %in% toupper(trimws(sexFilter))]
}
else
# Do not execute the filtering
foundAnimals <- animalListSEX
# Merge the list of extracted animals with the input set of animals to keep
# any additional columns from the input table
foundAnimals <-
data.table::merge.data.table(animalList,
foundAnimals,
by=c('STUDYID', 'USUBJID'))
# Do final preparation of set of found animals and return
prepareFinalResults(foundAnimals,
names(animalList),
c('SEX'))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.