Merge pull request #84 from OxfordIHTM/dev

checks for CoDEdit input data

NAMESPACE

@@ -14,6 +14,8 @@ export(cod_check_code_structure_icd10)
 export(cod_check_code_structure_icd11)
 export(cod_check_code_unlikely_icd10)
 export(cod_check_code_unlikely_icd11)
+export(cod_check_codedit_input)
+export(cod_check_dod)
 export(cod_check_sex)
 export(cod_recode_age_type)
 export(cod_recode_sex)

R/cod_check_dod.R

@@ -0,0 +1,33 @@
+#'
+#' Check date of death value in cause of death data based on CoDEdit rules
+#'
+#' @param dod Date of death value expressed in terms of the year death
+#'   occurred.
+#'
+#' @returns A tibble with number of rows equal to length of `dod` and
+#'   two columns for dod_check and dod_check_note.
+#'
+#' @examples
+#' cod_check_dod("2024")
+#'
+#' @rdname cod_check_dod
+#' @export
+#'
+
+cod_check_dod <- function(dod) {
+  dod_check <- ifelse(is.na(dod), 1L, 0L)
+
+  dod_check <- ifelse(
+    stringr::str_detect(string = dod, pattern = "[0-9]{4}", negate = TRUE),
+    1L, 0L
+  )
+
+  ## Create dod_check note vector ----
+  dod_check_note <- vector(mode = "character", length = length(dod))
+
+  dod_check_note[dod_check == 0] <- "No issues with date of death value"
+  dod_check_note[dod_check == 1] <- "Date of death value is not in year format"
+
+  tibble::tibble(dod_check, dod_check_note)
+}
+

R/cod_check_input.R

@@ -0,0 +1,60 @@
+#'
+#' Check structure and values of input data to CoDEdit tool
+#'
+#' @param df A data.frame with 6 columns with names `"FreeId"`, `"Sex"`,
+#'   `"Age Value"`, `"Age Type"`, `"Code"`, and `"Death Date"` and compatible
+#'   with the input data required by the CoDEdit tool.
+#'
+#' @returns A data.frame containing check codes and check notes for each row
+#'   and variable identified with the `FreeId` of `df`.
+#'
+#' @examples
+#' cod_check_codedit_input(icd10_example)
+#'
+#' @rdname cod_check_input
+#' @export
+#'
+
+cod_check_codedit_input <- function(df) {
+  ## Expected field names ----
+  fields <- c("FreeId", "Sex", "Age Value", "Age Type", "Code", "Death Date")
+
+  missing_fields <- !fields %in% names(df)
+
+  ## Check that all expected fields are present ----
+  if (any(missing_fields)) {
+    warning(
+      paste0(
+        "The data has the following missing fields: ",
+        paste(fields[missing_fields], collapse = ", "), "."
+      )
+    )
+  }
+
+  ## Check sex ----
+  sex_check <- cod_check_sex(sex_value = df$Sex)
+
+  ## Check age ----
+  age_check <- cod_check_age(
+    age_value = df$`Age Value`, age_type = df$`Age Type`
+  )
+
+  ## Check if code is missing ---
+  code_check <- ifelse(is.na(df$Code), 1L, 0L)
+  code_check_note <- ifelse(
+    code_check == 1L,
+    "Cause of death code is missing.",
+    "Cause of death code is not missing."
+    )
+
+  ## Check if date of death is missing ---
+  dod_check <- cod_check_dod(df$`Death Date`)
+
+  ## Return tibble of check results ----
+  tibble::tibble(
+    sex_check, age_check,
+    code_check = tibble::tibble(code_check, code_check_note),
+    dod_check
+  )
+}
+

R/cod_check_sex.R

@@ -5,7 +5,8 @@
 #'   CoDEdit rules.
 #' @param sex_code A character or integer vector of 2 values that indicate
 #'   which values are to be considered pertaining to males (first value in the
-#'   vector) or to females (second value in the vector).
+#'   vector) or to females (second value in the vector). Default is 1 for male
+#'   and 2 for female.
 #'
 #' @returns A tibble with number of rows equal to length of `sex_value` and
 #'   two columns for sex_check and sex_check_note.
@@ -19,7 +20,7 @@
 #' @export
 #'
 
-cod_check_sex <- function(sex_value, sex_code) {
+cod_check_sex <- function(sex_value, sex_code = c(1, 2)) {
   ## Recode sex ----
   sex_value <- cod_recode_sex(sex_value = sex_value, sex_code = sex_code)
 

inst/WORDLIST

@@ -14,6 +14,7 @@ Umanah
 WIP
 YYYY
 codedit
+dod
 icd
 icdcdn
 int

pkgdown/_pkgdown.yml

@@ -61,6 +61,8 @@ reference:
     contents:
     - cod_check_age
     - cod_check_sex
+    - cod_check_dod
+    - cod_check_codedit_input
     - cod_check_code
 
   - title: Structure