R/mHHS.R

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

#' @title {Calculates a modified version of the Harris Hip Score (mHHS)}
#' @description {\emph{The Harris hip score (HHS) is a joint specific score that
#' is completed by both the clinician and the patient and consists of 10 items
#' covering domains of pain, function, functional activities, deformity and
#' hip range of motion.} (\doi{10.1016/j.jor.2017.12.001})
#' \emph{Since range of motion and deformity cannot be assessed by telephone,
#' only pain and function are assessed (with the mHHS). This produces a maximum score of 91,
#' which is multiplied by a factor of 1.1 in order to derive a final score out of 100.}
#' (\doi{10.1258/1357633054068883})}
#' @details
#' \itemize{
#' \item \code{Number of items:} {8}
#' \item \code{Item range:}
#'      \itemize{
#'      \item \code{Pain} {1 to 6}
#'      \item \code{Limp} {1 to 4}
#'      \item \code{Support} {1 to 7}
#'      \item \code{Distance} {1 to 6}
#'      \item \code{Stairs} {1 to 4}
#'      \item \code{Shoes} {1 to 3}
#'      \item \code{Sitting} {1 to 3}
#'      \item \code{Transport} {1 to 2}
#'              }
#' \item \code{Reverse items:} {none}
#' \item \code{Score range:} {0 to 100}
#' \item \code{Cut-off-values:} {none}
#' \item \code{Minimal clinically important difference:} {none}
#' \item \code{Treatment of missing values:} {No missing values allowed for score calculation}
#' }
#' @references
#' Sharma et al (2005) (\doi{10.1258/1357633054068883})
#'
#' Link to questionnaire (\url{https://www.losangelessportssurgeon.com/pdf/modified-harris-hip-score.pdf})
#' @return The function returns 9 variables:
#' \itemize{
#'  \item \code{score.mHHS.pain:} {mHHS Pain}
#'  \item \code{score.mHHS.limp:} {mHHS Limp}
#'  \item \code{score.mHHS.support:} {mHHS Support}
#'  \item \code{score.mHHS.distance:} {mHHS Distance}
#'  \item \code{score.mHHS.stairs:} {mHHS Stairs}
#'  \item \code{score.mHHS.shoes:} {mHHS Shoes}
#'  \item \code{score.mHHS.sitting:} {mHHS Sitting}
#'  \item \code{score.mHHS.transport:} {mHHS Transport}
#'  \item \code{score.mHHS:} {mHHS Global}
#' }
#' @param data a \code{\link{data.frame}} containing the mHHS items ordered from 1 to 8.
#' The \code{\link{data.frame}} may contain further variables.
#' @param items A character vector with the mHHS item names ordered from 1 to 8,
#' or a numeric vector indicating the column numbers of the mHHS 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.
#' @export
scoring_mHHS <- function(data, items = 1:8, keep = TRUE) {
  library(dplyr, warn.conflicts = FALSE)
  # check for number of specified items
  if (length(items) != 8) {
    stop("Number of items must be 8!")
  }
  pain <- items[1]
  limp <- items[2]
  support <- items[3]
  distance <- items[4]
  stairs <- items[5]
  shoes <- items[6]
  sitting <- items[7]
  transport <- items[8]

  data <- data %>%
    mutate(
      score.mHHS.pain = case_when(
        pain == 1 ~ 44,
        pain == 2 ~ 40,
        pain == 3 ~ 30,
        pain == 4 ~ 20,
        pain == 5 ~ 10,
        pain == 6 ~ 0,
        TRUE ~ as.numeric(NA)
      ),
      score.mHHS.limp = case_when(
        limp == 1 ~ 11,
        limp == 2 ~ 8,
        limp == 3 ~ 5,
        limp == 4 ~ 0,
        TRUE ~ as.numeric(NA)
      ),
      score.mHHS.support = case_when(
        support == 1 ~ 11,
        support == 2 ~ 7,
        support == 3 ~ 5,
        support == 4 ~ 3,
        support == 5 ~ 2,
        support == 6 ~ 0,
        support == 7 ~ 0,
        TRUE ~ as.numeric(NA)
      ),
      score.mHHS.distance = case_when(
        distance == 1 ~ 11,
        distance == 2 ~ 8,
        distance == 3 ~ 5,
        distance == 4 ~ 2,
        distance == 5 ~ 0,
        distance == 6 ~ 0,
        TRUE ~ as.numeric(NA)
      ),
      score.mHHS.stairs = case_when(
        stairs == 1 ~ 4,
        stairs == 2 ~ 2,
        stairs == 3 ~ 1,
        stairs == 4 ~ 0,
        TRUE ~ as.numeric(NA)
      ),
      score.mHHS.shoes = case_when(
        shoes == 1 ~ 4,
        shoes == 2 ~ 2,
        shoes == 3 ~ 0,
        TRUE ~ as.numeric(NA)
      ),
      score.mHHS.sitting = case_when(
        sitting == 1 ~ 5,
        sitting == 2 ~ 3,
        sitting == 3 ~ 0,
        TRUE ~ as.numeric(NA)
      ),
      score.mHHS.transport = case_when(
        transport == 1 ~ 1,
        transport == 2 ~ 0,
        TRUE ~ as.numeric(NA)
      )
    ) %>%
    mutate(
      score.mHHS = rowSums(select(., starts_with("score.mHHS.")), na.rm = FALSE),
      score.mHHS = score.mHHS * 100 / 91
    )
  # Keep single items and sub scores
  if (keep == FALSE) {
    data <- data %>% select(-items, -starts_with("score.mHHS."))
  } else {
    data <- data
  }

  data
}
NULL