add functions to check code and age appropriateness; fix #7

NAMESPACE

@@ -4,6 +4,10 @@ export(cod_calculate_age)
 export(cod_calculate_ages)
 export(cod_check_age)
 export(cod_check_code)
+export(cod_check_code_age_icd10)
+export(cod_check_code_age_icd10_)
+export(cod_check_code_age_icd11)
+export(cod_check_code_age_icd11_)
 export(cod_check_code_ill_defined_icd10)
 export(cod_check_code_ill_defined_icd11)
 export(cod_check_code_sex_icd10)

R/cod_check_code.R

@@ -6,20 +6,22 @@
 #'   *"icd10"* or *"icd11"*. Default is *"icd10"*.
 #' @param sex A character value or vector of values for sex of individual
 #'   associated with the specified `cod`.
+#' @param age An integer value or vector of values for age (in years) of
+#'   individual.
 #'
 #' @returns A tibble with 2 columns/fields. First is an integer value indicating
 #'   whether there is an issue with the cause of death code provided in relation
 #'   to a potential code entry mistake and/or and issue of code completeness.
 #'
 #' @examples
-#' cod_check_code("U100", sex = 1)
-#' cod_check_code("2C6Z", version = "icd11", sex = 1)
+#' cod_check_code("U100", sex = 1, age = 10)
+#' cod_check_code("2C6Z", version = "icd11", sex = 1, age = 65)
 #'
 #' @rdname cod_check_code
 #' @export
 #'
 
-cod_check_code <- function(cod, version = c("icd10", "icd11"), sex) {
+cod_check_code <- function(cod, version = c("icd10", "icd11"), sex, age) {
   ## Determine value for version ----
   version <- match.arg(version)
 
@@ -45,17 +47,27 @@
   ) |>
     dplyr::rename_with(.fn = function(x) paste0(x, "_sex"))
 
+  cod_check_code_age <- eval(
+    parse(
+      text = paste0(
+        "cod_check_code_age_", version, "(cod = cod, age = age)"
+      )
+    )
+  ) |>
+    dplyr::rename_with(.fn = function(x) paste0(x, "_age"))
+
   tibble::tibble(
     cod_check_code_structure, cod_check_code_ill_defined,
-    cod_check_code_unlikely, cod_check_code_sex
+    cod_check_code_unlikely, cod_check_code_sex, cod_check_code_age
   ) |>
     dplyr::mutate(
       cod_check_code = rowSums(
         data.frame(
           .data$cod_check_structure,
           .data$cod_check_ill_defined,
           .data$cod_check_unlikely,
-          .data$cod_check_sex
+          .data$cod_check_sex,
+          .data$cod_check_age
         ),
         na.rm = TRUE
       ) |>
@@ -463,3 +475,101 @@
     dplyr::bind_rows()
 }
 
+
+#'
+#' @rdname cod_check_code
+#' @export
+#'
+
+cod_check_code_age_icd10_ <- function(cod, age) {
+  if (cod %in% codeditr::icd10_cod_neonate$code) {
+    cod_check <- ifelse(age < 1, 0L, 1L)
+  } else {
+    if (cod %in% codeditr::icd10_cod_child$code) {
+      cod_check <- ifelse(age < 18, 0L, 1L)
+    } else {
+      cod_check <- 0L
+    }
+  }
+
+  cod_check_note <- ifelse(
+    cod_check == 0L,
+    "No issues found in CoD code",
+    "CoD code is not appropriate for person's age"
+  )
+
+  tibble::tibble(cod_check, cod_check_note) |>
+    dplyr::mutate(
+      cod_check_note = factor(
+        x = cod_check_note,
+        levels = c(
+          "No issues found in CoD code",
+          "CoD code is not appropriate for person's age"
+        )
+      )
+    )
+}
+
+
+#'
+#' @rdname cod_check_code
+#' @export
+#'
+
+cod_check_code_age_icd10 <- function(cod, age) {
+  Map(
+    f = cod_check_code_age_icd10_,
+    cod = cod,
+    age = age
+  ) |>
+    dplyr::bind_rows()
+}
+
+#'
+#' @rdname cod_check_code
+#' @export
+#'
+
+cod_check_code_age_icd11_ <- function(cod, age) {
+  if (cod %in% codeditr::icd11_cod_neonate$code) {
+    cod_check <- ifelse(age < 1, 0L, 1L)
+  } else {
+    if (cod %in% codeditr::icd11_cod_child$code) {
+      cod_check <- ifelse(age < 18, 0L, 1L)
+    } else {
+      cod_check <- 0L
+    }
+  }
+
+  cod_check_note <- ifelse(
+    cod_check == 0L,
+    "No issues found in CoD code",
+    "CoD code is not appropriate for person's age"
+  )
+
+  tibble::tibble(cod_check, cod_check_note) |>
+    dplyr::mutate(
+      cod_check_note = factor(
+        x = cod_check_note,
+        levels = c(
+          "No issues found in CoD code",
+          "CoD code is not appropriate for person's age"
+        )
+      )
+    )
+}
+
+
+#'
+#' @rdname cod_check_code
+#' @export
+#'
+
+cod_check_code_age_icd11 <- function(cod, age) {
+  Map(
+    f = cod_check_code_age_icd11_,
+    cod = cod,
+    age = age
+  ) |>
+    dplyr::bind_rows()
+}

R/cod_summary.R

@@ -10,7 +10,10 @@
 #'   Otherwise, a tabulated summary of check outputs.
 #'
 #' @examples
-#' cod_check_code(cod_data_raw_example$code, version = "icd11", sex = "sex") |>
+#' cod_check_code(
+#'   cod_data_raw_example$code, version = "icd11",
+#'   sex = cod_data_raw_example$sex", age = cod_data_raw_example$age
+#' ) |>
 #'   cod_check_code_summary()
 #'
 #' @rdname cod_check_code_summary
@@ -23,13 +26,15 @@
     cod_check |> dplyr::select(dplyr::contains("note_ill")),
     cod_check |> dplyr::select(dplyr::contains("note_unlikely")),
     cod_check |> dplyr::select(dplyr::contains("note_sex")),
+    cod_check |> dplyr::select(dplyr::contains("note_age")),
     cod_check |> dplyr::select(dplyr::all_of("cod_check_code_note"))
   ) |>
     (\(x)
       {
         names(x) <- c(
           "Code structure", "Ill-defined code",
           "Unlikely cause-of-death code", "Code not appropriate for sex",
+          "Code not appropriate for age",
           "Overall"
         )
         x

R/data.R

@@ -138,3 +138,77 @@
 #' cod_data_raw_example
 #'
 "cod_data_raw_example"
+
+
+#'
+#' Neonate-specific cause of death for ICD 10
+#'
+#' @format A data frame with 2 columns and 42 rows:
+#'
+#' | **Variable** | **Description** |
+#' | :--- | :--- |
+#' | *code* | ICD 10 Cause of Death code |
+#' | *title* | Cause of death title |
+#'
+#'
+#' @examples
+#' icd10_cod_neonate
+#'
+#' @source https://www.icd10data.com/ICD10CM/Codes/Rules/Newborn_Codes
+#'
+"icd10_cod_neonate"
+
+
+#'
+#' Neonate-specific cause of death for ICD 11
+#'
+#' @format A data frame with 2 columns and 50 rows:
+#'
+#' | **Variable** | **Description** |
+#' | :--- | :--- |
+#' | *code* | ICD 11 Cause of Death code |
+#' | *title* | Cause of death title |
+#'
+#'
+#' @examples
+#' icd11_cod_neonate
+#'
+#'
+"icd11_cod_neonate"
+
+
+#'
+#' Child-specific cause of death for ICD 10
+#'
+#' @format A data frame with 2 columns and 122 rows:
+#'
+#' | **Variable** | **Description** |
+#' | :--- | :--- |
+#' | *code* | ICD 10 Cause of Death code |
+#' | *title* | Cause of death title |
+#'
+#'
+#' @examples
+#' icd10_cod_child
+#'
+#' @source https://www.icd10data.com/ICD10CM/Codes/Rules/Pediatric_Codes
+#'
+"icd10_cod_child"
+
+
+#'
+#' Child-specific cause of death for ICD 11
+#'
+#' @format A data frame with 2 columns and 149 rows:
+#'
+#' | **Variable** | **Description** |
+#' | :--- | :--- |
+#' | *code* | ICD 11 Cause of Death code |
+#' | *title* | Cause of death title |
+#'
+#'
+#' @examples
+#' icd11_cod_child
+#'
+#'
+"icd11_cod_child"