R/afeqt.R

In nrkoehler/qscorer: Procedures for Scoring Health-related Questionnaires

#' @title {Scoring the Atrial Fibrillation Effect on QualiTy-of-Life Questionnaire (AFEQT)}
#' @description {\emph{The AFEQT questionnaire is an atrial fibrillation-specific
#' health-related quality of life (HRQoL) questionnaire designed to [...] assess
#' the impact of atrial fibrillation on patients’ HRQoL
#' and possibly assess changes with treatment. [...]
#' Overall the subscale scores range from 0 to 100.
#' For Disability questions, a score of 0 corresponds to complete disability,
#' while a score of 100 corresponds to no disability.
#' For Satisfaction questions, a score of 100 indicates that
#' the patient is extremely satisfied with current treatment.
#' questions 19 and 20 regarding satisfaction with health care providers and with treatment
#' are not included in the overall AFEQT score and are each calculated
#' and scored independently.} (Scoring Manual)}
#' @details
#' \itemize{
#' \item \code{Number of items:} {20}
#' \item \code{Item range:} {1 to 7}
#' \item \code{Reverse items:} {none}
#' \item \code{Score range:} {0 to 100}
#' \item \code{Cut-off-values:} {none}
#' \item \code{Minimal clinically important difference:} {see: \url{https://doi.org/10.1016/j.ahj.2013.04.015}}
#' \item \code{Treatment of missing values:} {"For AFEQT, at least 50% of completed responses for
#' each domain are required to calculate a meaningful score." (Spertus et al. 2010) }
#' }
#' @references
#' Spertus J (2010) (\url{https://doi.org/10.1161/CIRCEP.110.958033})
#'
#' Scoring Manual (\url{http://afeqt.org/files/AFEQT_Questionnaire_Scoring_Guide.pdf})
#'
#' Link to Questionnaire (\url{http://www.afeqt.org/files/AFEQT_Questionnaire.pdf})
#' @return The function returns 10 variables:
#' \itemize{
#'  \item \code{nvalid.afeqt.sym:} Number of valid values of Symptoms Subscale (MAX=4)
#'  \item \code{nvalid.afeqt.dac:} Number of valid values of Daily Activities Subscale (MAX=8)
#'  \item \code{nvalid.afeqt.trc:} Number of valid values of Treatment Concern Subscale (MAX=6)
#'  \item \code{nvalid.afeqt.glo:} Number of valid values of Global Scale (MAX=21)
#'  \item \code{score.afeqt.sym:} AFEQT Symptoms Score
#'  \item \code{score.afeqt.dac:} AFEQT Daily Activities Score
#'  \item \code{score.afeqt.trc:} AFEQT Treatment Concern Score
#'  \item \code{score.afeqt.glo:} AFEQT Global Score
#'  \item \code{score.afeqt.19:} AFEQT Item 19, recoded
#'  \item \code{score.afeqt.20:} AFEQT Item 20, recoded
#' }
#' @examples
#' \dontrun{
#' library(dplyr)
#' items.afeqt <- paste0("afeqt_", seq(1, 20, 1))
#' scoring_afeqt(mydata, items = items.afeqt)
#' }
#' @param data a \code{\link{data.frame}} containing the AFEQT items orderd from 1 to 20.
#' The \code{\link{data.frame}} may contain further variables.
#' @param items A character vector with the AFEQT item names ordered from 1 to 20,
#' or a numeric vector indicating the column numbers of the AFEQT items in \code{data}.
#' @param keep Logical, whether to keep the single items and  whether to return variables containing
#' the number of non-missing items on each scale for each respondent. The default is TRUE.
#' @param nvalid A named list indicating the number of non-missing items required for score
#' calculations. The defaults are:
#' \itemize{
#'  \item \code{sym = 2} {(Symptoms Score)}
#'  \item \code{dac = 4} {(Daily Activities Score)}
#'  \item \code{trc = 3} {(Treatment Concern Score)}
#' }
#' @param digits Integer of length one: value to round to. No rounding by default.
#' @export
scoring_afeqt <- function(data, items = 1:20, keep = TRUE, nvalid = list(sym = 2, dac = 4, trc = 3), digits = NULL) {
  library(dplyr, warn.conflicts = FALSE)
  # check whether item values are within the defined range
  if (min(data[, items], na.rm = T) < 1) {
    stop("Minimum possible value for AFEQT items is 1")
  } else if (max(data[, items], na.rm = T) > 7) {
    stop("Maximum possible value for AFEQT items is 7")
  }
  # check for number of specified items
  if (length(items) != 20) {
    stop("Number of items must be 20!")
  }
  nvalid[['glo']] <- nvalid[['sym']] + nvalid[['dac']] + nvalid[['trc']]
  items.sym <- items[c(1:4)]
  items.dac <- items[c(5:12)]
  items.trc <- items[c(13:18)]
  items.glo <- items[c(1:18)]
  item.19 <- items[19]
  item.20 <- items[20]
  data <- data %>%
    mutate(
      nvalid.afeqt.sym = rowSums(!is.na(select(., items.sym))),
      nvalid.afeqt.dac = rowSums(!is.na(select(., items.dac))),
      nvalid.afeqt.trc = rowSums(!is.na(select(., items.trc))),
      nvalid.afeqt.glo = rowSums(!is.na(select(., items))),
      score.afeqt.sym = ifelse(nvalid.afeqt.sym >= nvalid[["sym"]],
                               100 - ((rowSums(select(., items.sym), na.rm = TRUE) -
                                         nvalid.afeqt.sym) * 100) / (nvalid.afeqt.sym * 6), NA
      ),
      score.afeqt.dac = ifelse(nvalid.afeqt.dac >= nvalid[["dac"]],
                               100 - ((rowSums(select(., items.dac), na.rm = TRUE) -
                                         nvalid.afeqt.dac) * 100) / (nvalid.afeqt.dac * 6), NA
      ),
      score.afeqt.trc = ifelse(nvalid.afeqt.trc >= nvalid[["trc"]],
                               100 - ((rowSums(select(., items.trc), na.rm = TRUE) -
                                         nvalid.afeqt.trc) * 100) / (nvalid.afeqt.trc * 6), NA
      ),
      score.afeqt.glo = ifelse(nvalid.afeqt.glo >= nvalid[["glo"]],
                               100 - ((rowSums(select(., items.glo), na.rm = TRUE) -
                                         nvalid.afeqt.glo) * 100) / (nvalid.afeqt.glo * 6), NA
      ),
      score.afeqt.19 = rowSums(select(., item.19)),
      score.afeqt.20 = rowSums(select(., item.20))
    ) %>%
    mutate_at(vars(score.afeqt.19:score.afeqt.20), list(~case_when(
      . == 1 ~ 100,
      . == 2 ~ 83.3,
      . == 3 ~ 66.7,
      . == 4 ~ 50,
      . == 5 ~ 33.3,
      . == 6 ~ 16.7,
      . == 7 ~ 0,
      TRUE ~ as.numeric(NA)
    )))
  # Keep single items and nvalid variables
  if (keep == FALSE) {
    data <- data %>% select(-items, -nvalid.afeqt.sym, -nvalid.afeqt.dac,
                            -nvalid.afeqt.trc, nvalid.afeqt.glo)
  } else {
    data <- data
  }
  # Rounding
  if (is.numeric(digits) == TRUE) {
    data <- data %>% mutate_at(
      vars(
        score.debq.emo, score.debq.ext,
        score.debq.res, score.debq.tot
      ),
      list(~ round(., digits))
    )
  } else {
    data <- data
  }
  data
}
NULL