R/clean_nkbc_data.R

In oc1lojo/nkbcgeneral: Generella verktyg för NKBC

#' @export
clean_nkbc_data <- function(x, ...) {
  x <- x %>%
    dplyr::rename_with(stringr::str_replace, tidyselect::everything(), "_PosNameWithCode_[0-9]", "") %>%
    dplyr::rename_with(stringr::str_replace, tidyselect::everything(), "sjhKlk", "sjhklk") %>%
    dplyr::mutate(dplyr::across(tidyselect::ends_with("_Varde"), as.integer)) %>%
    dplyr::mutate(dplyr::across(tidyselect::ends_with("_Beskrivning"), dplyr::na_if, "")) %>%
    dplyr::mutate(
      dplyr::across(
        tidyselect::ends_with("sjhkod"),
        function(y) {
          as.character(y) %>%
            stringr::str_replace("UAS", "12001") %>%
            stringr::str_replace("22010s", "22010") %>%
            as.integer()
        }
      )
    ) %>%
    dplyr::mutate(
      dplyr::across(
        tidyselect::ends_with("dat", ignore.case = FALSE),
        lubridate::ymd
      )
    ) %>%
    # Städa fritext-variabler från specialtecken
    # Följande kod används inte p.g.a. https://github.com/r-lib/tidyselect/issues/201
    # dplyr::mutate(
    #   dplyr::across(
    #     where(is.character),
    #     function(y) gsub("[[:space:]]", " ", y)
    #   )
    # )
    dplyr::mutate_if(is.character, function(y) gsub("[[:space:]]", " ", y))

  if ("VITALSTATUSDATUM_ESTIMAT" %in% names(x)) {
    x <- x %>%
      dplyr::mutate(
        VITALSTATUSDATUM_ESTIMAT = lubridate::ymd(VITALSTATUSDATUM_ESTIMAT)
      )
  }

  # Kräv att diagnosdatum är satt
  if ("a_diag_dat" %in% names(x)) {
    x <- dplyr::filter(x, !is.na(a_diag_dat))
  }

  # Rensa ev. rena dubbletter
  if ("R44T139_ID" %in% names(x)) {
    x <- dplyr::distinct(x)
  }

  # Rensa operationsformulärdata om inte operationsdatum är satt
  if ("op_kir_dat" %in% names(x)) {
    x[is.na(x$op_kir_dat), tidyselect::vars_select(names(x), tidyselect::starts_with("op_"))] <- NA
  }

  # Rensa formulärdata om inte pat_sida är vald för formulär
  if ("op_pat_sida_Varde" %in% names(x)) {
    x[is.na(x$op_pat_sida_Varde), stringr::str_subset(names(x), "^op_")] <- NA
  }
  if ("pre_pat_sida_Varde" %in% names(x)) {
    x[is.na(x$pre_pat_sida_Varde), stringr::str_subset(names(x), "^pre_")] <- NA
  }
  if ("post_pat_sida_Varde" %in% names(x)) {
    x[is.na(x$post_pat_sida_Varde), stringr::str_subset(names(x), "^post_")] <- NA
  }
  if ("r_pat_sida_Varde" %in% names(x)) {
    x[is.na(x$r_pat_sida_Varde), stringr::str_subset(names(x), "^r_")] <- NA
  }

  # Hantera LKF-kod
  if ("a_pat_lkfdia" %in% names(x)) {
    x <- x %>%
      dplyr::mutate(
        a_pat_lkfdia = dplyr::case_when(
          is.na(a_pat_lkfdia) ~ NA_character_,
          suppressWarnings(as.integer(a_pat_lkfdia)) < 10000 ~ sprintf("%04d", suppressWarnings(as.integer(a_pat_lkfdia))),
          suppressWarnings(as.integer(a_pat_lkfdia)) < 1000000 ~ sprintf("%06d", suppressWarnings(as.integer(a_pat_lkfdia))),
          TRUE ~ as.character(a_pat_lkfdia)
        )
      )
  }

  # Korrigera värden
  if ("op_pad_lglmetant" %in% names(x)) {
    if (!("op_pad_lglusant" %in% names(x))) {
      stop("För att korrigera op_pad_lglmetant behöver op_pad_lglusant vara med.")
    } else {
      x <- x %>%
        dplyr::mutate(
          # Kräv att totalt antal undersökta lymfkörtlar från samtliga axillingrepp (op_pad_lglusant) > 0
          # för att totalt antal lymfkörtlar med metastas från samtliga axillingrepp (op_pad_lglmetant) skall ha ett värde
          op_pad_lglmetant = dplyr::if_else(op_pad_lglusant > 0, op_pad_lglmetant, NA_integer_)
        )
    }
  }

  return(x)
}