R/getSubjSex.R

In sendigR: Enable Cross-Study Analysis of 'CDISC' 'SEND' Datasets

################################################################################
## 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'))
}