From e4af8a376e88c42541d3a400e2af89c25acec2c3 Mon Sep 17 00:00:00 2001 From: Peter DeWitt Date: Mon, 27 Oct 2025 14:34:01 -0600 Subject: [PATCH 1/5] check the results are the same for a factor as a character in is_icd --- tests/test-is_icd.R | 28 ++++++++++++++++++++++++---- 1 file changed, 24 insertions(+), 4 deletions(-) diff --git a/tests/test-is_icd.R b/tests/test-is_icd.R index 1ef29d6e..2a11b8eb 100644 --- a/tests/test-is_icd.R +++ b/tests/test-is_icd.R @@ -38,11 +38,16 @@ stopifnot( # FALSE if the dot is in the wrong place x <- c("7993", ".7993", "7.993", "79.93", "799.3", "7993.") +f <- factor(x) stopifnot( identical(is_icd(x, icdv = 9, dx = 1L), c(TRUE, FALSE, FALSE, FALSE, TRUE, FALSE)), identical(is_icd(x, icdv = 9, dx = 0L), c(TRUE, FALSE, FALSE, TRUE, FALSE, FALSE)), !any(is_icd(x, icdv = 10, dx = 1L)), - !any(is_icd(x, icdv = 10, dx = 0L)) + !any(is_icd(x, icdv = 10, dx = 0L)), + identical(is_icd(x, icdv = 9, dx = 1L), is_icd(f, icdv = 9, dx = 1L)), + identical(is_icd(x, icdv = 9, dx = 0L), is_icd(f, icdv = 9, dx = 0L)), + identical(is_icd(x, icdv = 10, dx = 1L), is_icd(f, icdv = 10, dx = 1L)), + identical(is_icd(x, icdv = 10, dx = 0L), is_icd(f, icdv = 10, dx = 0L)) ) # expect a warning that 7993 is ambiguous @@ -62,11 +67,16 @@ x <- c("C441121", "C4411.21", "C44112.1", "C441121.") +f <- factor(x) stopifnot( identical(is_icd(x, icdv = 10, dx = 1L), c(TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE)), !any(is_icd(x, icdv = 9, dx = 1L)), !any(is_icd(x, icdv = 9, dx = 0L)), - !any(is_icd(x, icdv = 10, dx = 0L)) + !any(is_icd(x, icdv = 10, dx = 0L)), + identical(is_icd(x, icdv = 9, dx = 1L), is_icd(f, icdv = 9, dx = 1L)), + identical(is_icd(x, icdv = 9, dx = 0L), is_icd(f, icdv = 9, dx = 0L)), + identical(is_icd(x, icdv = 10, dx = 1L), is_icd(f, icdv = 10, dx = 1L)), + identical(is_icd(x, icdv = 10, dx = 0L), is_icd(f, icdv = 10, dx = 0L)) ) # another example @@ -79,12 +89,17 @@ x <- c("Y389X2S", "Y389X.2S", "Y389X2.S", "Y389X2S.") +f <- factor(x) stopifnot( identical(is_icd(x), c(TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE)), identical(is_icd(x, icdv = 10, dx = 1L), c(TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE)), !any(is_icd(x, icdv = 9, dx = 1L)), !any(is_icd(x, icdv = 9, dx = 0L)), - !any(is_icd(x, icdv = 10, dx = 0L)) + !any(is_icd(x, icdv = 10, dx = 0L)), + identical(is_icd(x, icdv = 9, dx = 1L), is_icd(f, icdv = 9, dx = 1L)), + identical(is_icd(x, icdv = 9, dx = 0L), is_icd(f, icdv = 9, dx = 0L)), + identical(is_icd(x, icdv = 10, dx = 1L), is_icd(f, icdv = 10, dx = 1L)), + identical(is_icd(x, icdv = 10, dx = 0L), is_icd(f, icdv = 10, dx = 0L)) ) # ICD 10 pr codes have no dots @@ -97,12 +112,17 @@ x <- c("0016074", "00160.74", "001607.4", "0016074.") +f <- factor(x) stopifnot( identical(is_icd(x), c(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE)), identical(is_icd(x, icdv = 10, dx = 0L), c(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE)), !any(is_icd(x, icdv = 9, dx = 1L)), !any(is_icd(x, icdv = 9, dx = 0L)), - !any(is_icd(x, icdv = 10, dx = 1L)) + !any(is_icd(x, icdv = 10, dx = 1L)), + identical(is_icd(x, icdv = 9, dx = 1L), is_icd(f, icdv = 9, dx = 1L)), + identical(is_icd(x, icdv = 9, dx = 0L), is_icd(f, icdv = 9, dx = 0L)), + identical(is_icd(x, icdv = 10, dx = 1L), is_icd(f, icdv = 10, dx = 1L)), + identical(is_icd(x, icdv = 10, dx = 0L), is_icd(f, icdv = 10, dx = 0L)) ) ################################################################################ From b925a28161dc90dc78a1629cc45996032cc4c3ba Mon Sep 17 00:00:00 2001 From: Peter DeWitt Date: Mon, 27 Oct 2025 15:09:05 -0600 Subject: [PATCH 2/5] extend testing of is_icd() --- tests/test-is_icd.R | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/tests/test-is_icd.R b/tests/test-is_icd.R index 2a11b8eb..d0585e9c 100644 --- a/tests/test-is_icd.R +++ b/tests/test-is_icd.R @@ -30,6 +30,25 @@ stopifnot( code_length_one_icd10pr = length(icd10pr) == 36L && !any(icd10pr) ) +################################################################################ +# check for early return if the input combination of icdv, dx, src excludes all +# possible codes +x <- c("7993", ".7993", "7.993", "79.93", "799.3", "7993.") +y <- rep_len(FALSE, length(x)) + +stopifnot( + "failed to stop on bad icdv" = inherits(tryCatchError(is_icd(x, icdv = 8)), "error"), + "failed to stop on bad src" = inherits(tryCatchError(is_icd(x, src = "a")), "error"), + "failed to stop on bad dx" = inherits(tryCatchError(is_icd(x, dx = 2)), "error"), + "warning for WHO and ICD 9" = inherits(tryCatchWarning(is_icd(x, icdv = 9, src = "who")), "warning"), + "all FALSE for WHO and ICD 9" = identical(suppressWarnings(is_icd(x, icdv = 9, src = "who")), y), + "warning for CDC and ICD 9" = inherits(tryCatchWarning(is_icd(x, icdv = 9, src = "cdc")), "warning"), + "all FALSE for CDC and ICD 9" = identical(suppressWarnings(is_icd(x, icdv = 9, src = "cdc")), y), + "warning for WHO, ICD-10, pr" = inherits(tryCatchWarning(is_icd(x, icdv = 10, src = "who", dx = 0)), "warning"), + "all FLASE for WHO, ICD-10, pr" = identical(suppressWarnings(is_icd(x, icdv = 10, src = "who", dx = 0)), y) +) + + ################################################################################ # For ICD-9 test that the presense of a dot is considered when testing. # Example 7993 is the simplified version of the proper ICD-9 DX code 799.3 and From f2307d34994f133f4def354f4c539458c995249f Mon Sep 17 00:00:00 2001 From: Peter DeWitt Date: Mon, 27 Oct 2025 17:19:27 -0600 Subject: [PATCH 3/5] extend tests for summary methods --- tests/test-summary-charlson.R | 123 +++++++++++++++++ tests/test-summary-elixhauser.R | 126 ++++++++++++++++++ tests/{test-summary.R => test-summary-pccc.R} | 0 3 files changed, 249 insertions(+) create mode 100644 tests/test-summary-charlson.R create mode 100644 tests/test-summary-elixhauser.R rename tests/{test-summary.R => test-summary-pccc.R} (100%) diff --git a/tests/test-summary-charlson.R b/tests/test-summary-charlson.R new file mode 100644 index 00000000..7a0d5551 --- /dev/null +++ b/tests/test-summary-charlson.R @@ -0,0 +1,123 @@ +source('utilities.R') +################################################################################ +# Tests for summarizing Charlson comorbidities +library(medicalcoder) + +################################################################################ +# Prepare input with an age variable to exercise age scoring logic +mdcr$age <- as.integer(substr(as.character(mdcr$patid), 1, 2)) + +charlson <- comorbidities( + data = mdcr, + id.vars = "patid", + icdv.var = "icdv", + icd.codes = "code", + dx.var = "dx", + method = "charlson_quan2011", + flag.method = "current", + poa = 1, + age.var = "age" +) + +summary_current <- summary(charlson) + +stopifnot( + is.list(summary_current), + identical(names(summary_current), c("conditions", "age_summary", "index_summary")), + is.data.frame(summary_current$conditions), + identical( + names(summary_current$conditions), + c("condition_description", "condition", "count", "percent") + ), + is.character(summary_current$conditions$condition_description), + is.character(summary_current$conditions$condition), + is.numeric(summary_current$conditions$count), + is.numeric(summary_current$conditions$percent), + all(summary_current$conditions$count >= 0), + all(summary_current$conditions$percent >= 0), + all(summary_current$conditions$percent <= 100) +) + +################################################################################ +# Conditions summary matches direct aggregations +aidshiv_count <- summary_current$conditions[ + !is.na(summary_current$conditions$condition) & + summary_current$conditions$condition == "aidshiv", + "count" +] +copd_count <- summary_current$conditions[ + !is.na(summary_current$conditions$condition) & + summary_current$conditions$condition == "copd", + "count" +] + +stopifnot( + aidshiv_count == sum(charlson$aidshiv), + copd_count == sum(charlson$copd) +) + +num_ge_1 <- summary_current$conditions[ + is.na(summary_current$conditions$condition) & + summary_current$conditions$condition_description == ">= 1", + "count" +] +num_ge_2 <- summary_current$conditions[ + is.na(summary_current$conditions$condition) & + summary_current$conditions$condition_description == ">= 2", + "count" +] + +stopifnot( + num_ge_1 == sum(charlson$num_cmrb >= 1), + num_ge_2 == sum(charlson$num_cmrb >= 2) +) + +################################################################################ +# Age and index summaries align with expected calculations +expected_age_summary <- + merge( + x = stats::setNames(as.data.frame(table(charlson$age_score, useNA = "always")), c("age_score", "count")), + y = stats::setNames(as.data.frame(100 * prop.table(table(charlson$age_score, useNA = "always"))), c("age_score", "percent")), + by = "age_score" + ) + +stopifnot(identical(summary_current$age_summary, expected_age_summary)) + +expected_index_summary <- + data.frame( + min = min(charlson$cci), + q1 = stats::quantile(charlson$cci, prob = 0.25), + median = stats::median(charlson$cci), + q3 = stats::quantile(charlson$cci, prob = 0.75), + max = max(charlson$cci), + row.names = NULL + ) + +stopifnot(identical(summary_current$index_summary, expected_index_summary)) + +################################################################################ +# A non-current flag.method generates a warning but still returns the summary +charlson_cumulative <- charlson +attr(charlson_cumulative, "flag.method") <- "cumulative" + +warn_obj <- tryCatchWarning(summary(charlson_cumulative)) + +stopifnot( + inherits(warn_obj, "warning"), + identical( + conditionMessage(warn_obj), + "Logic for charlson summary table has been implemented for flag.method = 'current'. Using this function for flag.method = 'cumulative' may not provide a meaningful summary." + ) +) + +summary_cumulative <- suppressWarnings(summary(charlson_cumulative)) + +stopifnot( + identical(summary_cumulative$conditions, summary_current$conditions), + identical(summary_cumulative$age_summary, summary_current$age_summary), + identical(summary_cumulative$index_summary, summary_current$index_summary) +) + +################################################################################ +# End of File # +################################################################################ diff --git a/tests/test-summary-elixhauser.R b/tests/test-summary-elixhauser.R new file mode 100644 index 00000000..94cd967a --- /dev/null +++ b/tests/test-summary-elixhauser.R @@ -0,0 +1,126 @@ +source('utilities.R') +################################################################################ +# Tests for summarizing Elixhauser comorbidities +library(medicalcoder) + +################################################################################ +# Build Elixhauser comorbidities and summary +elixhauser <- comorbidities( + data = mdcr, + id.vars = "patid", + icdv.var = "icdv", + icd.codes = "code", + dx.var = "dx", + method = "elixhauser_ahrq2025", + flag.method = "current", + poa = 1, + primarydx = 0 +) + +summary_current <- summary(elixhauser) + +stopifnot( + is.list(summary_current), + identical(names(summary_current), c("conditions", "index_summary")), + is.data.frame(summary_current$conditions), + identical( + names(summary_current$conditions), + c("condition", "count", "percent") + ), + is.character(summary_current$conditions$condition), + is.numeric(summary_current$conditions$count), + is.numeric(summary_current$conditions$percent), + all(summary_current$conditions$count >= 0), + all(summary_current$conditions$percent >= 0), + all(summary_current$conditions$percent <= 100) +) + +################################################################################ +# Conditions summary matches direct aggregations +hf_count <- summary_current$conditions[ + summary_current$conditions$condition == "HF", + "count" +] +diab_cx_count <- summary_current$conditions[ + summary_current$conditions$condition == "DIAB_CX", + "count" +] + +stopifnot( + hf_count == sum(elixhauser$HF), + diab_cx_count == sum(elixhauser$DIAB_CX) +) + +num_ge_1 <- summary_current$conditions[ + summary_current$conditions$condition == ">= 1", + "count" +] +num_ge_2 <- summary_current$conditions[ + summary_current$conditions$condition == ">= 2", + "count" +] + +stopifnot( + num_ge_1 == sum(elixhauser$num_cmrb >= 1), + num_ge_2 == sum(elixhauser$num_cmrb >= 2) +) + +################################################################################ +# Index summary aligns with expected calculations +stopifnot( + is.data.frame(summary_current$index_summary), + identical( + names(summary_current$index_summary), + c("index", "min", "q1", "median", "q3", "max") + ), + is.character(summary_current$index_summary$index), + is.numeric(summary_current$index_summary$min), + is.numeric(summary_current$index_summary$q1), + is.numeric(summary_current$index_summary$median), + is.numeric(summary_current$index_summary$q3), + is.numeric(summary_current$index_summary$max) +) + +expected_index_summary <- + data.frame( + index = c("readmission", "mortality"), + min = c(min(elixhauser$readmission_index), + min(elixhauser$mortality_index)), + q1 = c(stats::quantile(elixhauser$readmission_index, prob = 0.25), + stats::quantile(elixhauser$mortality_index, prob = 0.25)), + median = c(stats::median(elixhauser$readmission_index), + stats::median(elixhauser$mortality_index)), + q3 = c(stats::quantile(elixhauser$readmission_index, prob = 0.75), + stats::quantile(elixhauser$mortality_index, prob = 0.75)), + max = c(max(elixhauser$readmission_index), + max(elixhauser$mortality_index)), + row.names = NULL + ) + +stopifnot(identical(summary_current$index_summary, expected_index_summary)) + +################################################################################ +# A non-current flag.method generates a warning but still returns the summary +elixhauser_cumulative <- elixhauser +attr(elixhauser_cumulative, "flag.method") <- "cumulative" + +warn_obj <- tryCatchWarning(summary(elixhauser_cumulative)) + +stopifnot( + inherits(warn_obj, "warning"), + identical( + conditionMessage(warn_obj), + "Logic for Elixhauser summary has been implemented for flag.method = 'current'. Using this function for flag.method = 'cumulative' may not provide a meaningful summary." + ) +) + +summary_cumulative <- suppressWarnings(summary(elixhauser_cumulative)) + +stopifnot( + identical(summary_cumulative$conditions, summary_current$conditions), + identical(summary_cumulative$index_summary, summary_current$index_summary) +) + +################################################################################ +# End of File # +################################################################################ diff --git a/tests/test-summary.R b/tests/test-summary-pccc.R similarity index 100% rename from tests/test-summary.R rename to tests/test-summary-pccc.R From c1ac0a9fbf1f966c816d5cf50a246b10b17da7b5 Mon Sep 17 00:00:00 2001 From: Peter DeWitt Date: Mon, 27 Oct 2025 17:27:01 -0600 Subject: [PATCH 4/5] extend tests for icd_compact_to_full --- tests/test-icd_compact_to_full.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/tests/test-icd_compact_to_full.R b/tests/test-icd_compact_to_full.R index 6e0ebd4f..3883de54 100644 --- a/tests/test-icd_compact_to_full.R +++ b/tests/test-icd_compact_to_full.R @@ -12,6 +12,13 @@ stopifnot(identical( c("E912.0","250.0","I21.4") )) +# ICD-9 procedure codes gain a decimal after the second character; scalars for +# icdv/dx are recycled across the input vector. +stopifnot(identical( + icd_compact_to_full(c("0309","1712"), icdv = 9, dx = 0), + c("03.09","17.12") +)) + ################################################################################ # End of File # ################################################################################ From e58e528e8e3d722920e61b7d1ac81714a9004b5a Mon Sep 17 00:00:00 2001 From: Peter DeWitt Date: Tue, 28 Oct 2025 14:26:02 -0600 Subject: [PATCH 5/5] add test-summary-pccc-subconditions.R --- tests/test-summary-pccc-subconditions.R | 130 ++++++++++++++++++++++++ 1 file changed, 130 insertions(+) create mode 100644 tests/test-summary-pccc-subconditions.R diff --git a/tests/test-summary-pccc-subconditions.R b/tests/test-summary-pccc-subconditions.R new file mode 100644 index 00000000..9b4dd1ef --- /dev/null +++ b/tests/test-summary-pccc-subconditions.R @@ -0,0 +1,130 @@ +source('utilities.R') +################################################################################ +# Tests for summarizing PCCC comorbidities with subconditions +library(medicalcoder) + +################################################################################ +# Build PCCC with subconditions and compute the summary +pccc_sub <- comorbidities( + data = mdcr, + id.vars = "patid", + icd.codes = "code", + icdv.var = "icdv", + dx.var = "dx", + method = "pccc_v3.1", + flag.method = "current", + poa = 1, + subconditions = TRUE +) + +summary_current <- summary(pccc_sub) + +stopifnot( + inherits(summary_current, "data.frame"), + identical( + names(summary_current), + c("condition", + "subcondition", + "count", + "percent_of_cohort", + "percent_of_those_with_condition") + ), + is.character(summary_current[["condition"]]), + is.character(summary_current[["subcondition"]]), + is.numeric(summary_current[["count"]]), + is.numeric(summary_current[["percent_of_cohort"]]), + is.numeric(summary_current[["percent_of_those_with_condition"]]), + all(summary_current[["count"]] >= 0), + all(summary_current[["percent_of_cohort"]] >= 0), + all(summary_current[["percent_of_cohort"]] <= 100), + all(is.na(summary_current[["percent_of_those_with_condition"]][is.na(summary_current[["subcondition"]])])), + all(summary_current[["percent_of_those_with_condition"]][!is.na(summary_current[["subcondition"]])] >= 0), + all(summary_current[["percent_of_those_with_condition"]][!is.na(summary_current[["subcondition"]])] <= 100) +) + +################################################################################ +# Condition-level counts align with the underlying comorbidity object +N <- nrow(pccc_sub[["conditions"]]) + +cvd_total <- sum(pccc_sub[["conditions"]][["cvd_dxpr_or_tech"]]) +cvd_row <- summary_current[ + summary_current[["condition"]] == "cvd" & + is.na(summary_current[["subcondition"]]), +] + +stopifnot( + nrow(cvd_row) == 1L, + cvd_row[["count"]] == cvd_total, + isTRUE(all.equal(cvd_row[["percent_of_cohort"]], 100 * cvd_total / N)), + is.na(cvd_row[["percent_of_those_with_condition"]]) +) + +resp_total <- sum(pccc_sub[["conditions"]][["respiratory_dxpr_or_tech"]]) +resp_row <- summary_current[ + summary_current[["condition"]] == "respiratory" & + is.na(summary_current[["subcondition"]]), +] + +stopifnot( + nrow(resp_row) == 1L, + resp_row[["count"]] == resp_total, + isTRUE(all.equal(resp_row[["percent_of_cohort"]], 100 * resp_total / N)), + is.na(resp_row[["percent_of_those_with_condition"]]) +) + +################################################################################ +# Subcondition counts and percentages match direct aggregations +cvd_sub <- pccc_sub[["subconditions"]][["cvd"]] +cvd_hgvm <- sum(cvd_sub[["heart_and_great_vessel_malformations"]]) + +cvd_hgvm_idx <- which( + summary_current[["condition"]] == "cvd" & + summary_current[["subcondition"]] == "heart_and_great_vessel_malformations" +) +cvd_hgvm_row <- summary_current[cvd_hgvm_idx, , drop = FALSE] + +stopifnot( + nrow(cvd_hgvm_row) == 1L, + cvd_hgvm_row[["count"]] == cvd_hgvm, + isTRUE(all.equal(cvd_hgvm_row[["percent_of_cohort"]], 100 * cvd_hgvm / N)), + isTRUE(all.equal(cvd_hgvm_row[["percent_of_those_with_condition"]], 100 * cvd_hgvm / cvd_total)) +) + +resp_sub <- pccc_sub[["subconditions"]][["respiratory"]] +resp_cystic_fibrosis <- sum(resp_sub[["cystic_fibrosis"]]) + +resp_cf_idx <- which( + summary_current[["condition"]] == "respiratory" & + summary_current[["subcondition"]] == "cystic_fibrosis" +) +resp_cf_row <- summary_current[resp_cf_idx, , drop = FALSE] + +stopifnot( + nrow(resp_cf_row) == 1L, + resp_cf_row[["count"]] == resp_cystic_fibrosis, + isTRUE(all.equal(resp_cf_row[["percent_of_cohort"]], 100 * resp_cystic_fibrosis / N)), + isTRUE(all.equal(resp_cf_row[["percent_of_those_with_condition"]], 100 * resp_cystic_fibrosis / resp_total)) +) + +################################################################################ +# A non-current flag.method emits a warning but returns the same summary +pccc_sub_cumulative <- pccc_sub +attr(pccc_sub_cumulative, "flag.method") <- "cumulative" + +warn_obj <- tryCatchWarning(summary(pccc_sub_cumulative)) + +stopifnot( + inherits(warn_obj, "warning"), + identical( + conditionMessage(warn_obj), + "Logic for pccc_summary_table has been implemented for flag.method = 'current'. Using this function for flag.method = 'cumulative' may not provide a meaningful summary." + ) +) + +summary_cumulative <- suppressWarnings(summary(pccc_sub_cumulative)) + +stopifnot(identical(summary_cumulative, summary_current)) + +################################################################################ +# End of File # +################################################################################