R Under development (unstable) (2025-10-08 r88906 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2025 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> ################################################################################
> library(medicalcoder)
> set.seed(42)
> 
> ################################################################################
> # verify an error will be thrown if lenght(id.vars) < 2 and flag.method =
> # "cumulative"
> 
> rtn <- # length(id.vars) = 0
+   tryCatch(
+     comorbidities(
+       data = mdcr,
+       icd.codes = "code",
+       poa = 1,
+       flag.method = 'cumulative',
+       method = "pccc_v3.1"
+     ),
+     error = function(e) e
+   )
> stopifnot(inherits(rtn, "error"))
> 
> rtn <- # length(id.vars) = 1
+   tryCatch(
+     comorbidities(
+       data = mdcr,
+       id.vars = "patid",
+       icd.codes = "code",
+       poa = 1,
+       flag.method = 'cumulative',
+       method = "pccc_v3.1"
+     ),
+     error = function(e) e
+   )
> stopifnot(inherits(rtn, "error"))
> 
> 
> ################################################################################
> # verify errors are thrown if a "protected" name is used for the id.vars,
> # poa.var, or primarydx.var
> mdcr2 <- mdcr
> mdcr2[["condition"]] <- 1L
> 
> x <-
+   tryCatch(
+     comorbidities(
+       data = mdcr2,
+       icd.codes = "code",
+       id.vars = c("patid", "condition"),
+       method = "pccc_v3.1"
+     ),
+   error = function(e) e
+ )
> stopifnot(inherits(x, "error"))
> 
> x <-
+   tryCatch(
+     comorbidities(
+       data = mdcr2,
+       icd.codes = "code",
+       id.vars = c("condition"),
+       method = "pccc_v3.1"
+     ),
+   error = function(e) e
+ )
> stopifnot(inherits(x, "error"))
> 
> x <-
+   tryCatch(
+     comorbidities(
+       data = mdcr2,
+       icd.codes = "code",
+       poa.vars = c("condition"),
+       method = "pccc_v3.1"
+     ),
+   error = function(e) e
+ )
> stopifnot(inherits(x, "error"))
> 
> # this calls be "valid" as primarydx.var is ignored when method is not
> # elixhauser_*
> x <-
+   tryCatch(
+     comorbidities(
+       data = mdcr2,
+       icd.codes = "code",
+       primarydx.var = "condition",
+       method = "elixhauser_ahrq2025"
+     ),
+   error = function(e) e
+ )
> stopifnot(inherits(x, "error"))
> 
> 
> ################################################################################
> # Test: check_and_set_*
> #
> # The check_and_set_* are non-exported methods.  We test them here with calls to
> # comorbidities() so that we can capture these test with covr
> 
> # Verify these methods are non-exported
> stopifnot(!("check_and_set_id_vars" %in% getNamespaceExports("medicalcoder")))
> 
> # The following data frames are used to test check_and_set_id_vars.
> # `..medicalcoder_id..` is the initial name used in the check and set when
> # creating an id column.  it needs to persist in the output if provided as an
> # id.
> DF0 <- data.frame(pid = NA, code = "A00")
> DF1 <- data.frame(medicalcoder_id = NA, code = "A00")
> DF2 <- data.frame(..medicalcoder_id.. = NA, code = "A00")
> 
> # verify that the constuction of a id.vars within the function works as
> # expected.
> OUT0 <- comorbidities(data = DF0, icd.codes = "code", method = "pccc_v3.0", poa = 1)
> OUT1 <- comorbidities(data = DF1, icd.codes = "code", method = "pccc_v3.0", poa = 1)
> OUT2 <- comorbidities(data = DF2, icd.codes = "code", method = "pccc_v3.0", poa = 1)
> 
> expected_names <-
+   c(
+     "congeni_genetic_dxpr_only",
+     "congeni_genetic_tech_only",
+     "congeni_genetic_dxpr_and_tech",
+     "congeni_genetic_dxpr_or_tech",
+ 
+     "cvd_dxpr_only",
+     "cvd_tech_only",
+     "cvd_dxpr_and_tech",
+     "cvd_dxpr_or_tech",
+ 
+     "gi_dxpr_only",
+     "gi_tech_only",
+     "gi_dxpr_and_tech",
+     "gi_dxpr_or_tech",
+ 
+     "hemato_immu_dxpr_only",
+     "hemato_immu_tech_only",
+     "hemato_immu_dxpr_and_tech",
+     "hemato_immu_dxpr_or_tech",
+ 
+     "malignancy_dxpr_only",
+     "malignancy_tech_only",
+     "malignancy_dxpr_and_tech",
+     "malignancy_dxpr_or_tech",
+ 
+     "metabolic_dxpr_only",
+     "metabolic_tech_only",
+     "metabolic_dxpr_and_tech",
+     "metabolic_dxpr_or_tech",
+ 
+     "misc_dxpr_only",
+     "misc_tech_only",
+     "misc_dxpr_and_tech",
+     "misc_dxpr_or_tech",
+ 
+     "neonatal_dxpr_only",
+     "neonatal_tech_only",
+     "neonatal_dxpr_and_tech",
+     "neonatal_dxpr_or_tech",
+ 
+     "neuromusc_dxpr_only",
+     "neuromusc_tech_only",
+     "neuromusc_dxpr_and_tech",
+     "neuromusc_dxpr_or_tech",
+ 
+     "renal_dxpr_only",
+     "renal_tech_only",
+     "renal_dxpr_and_tech",
+     "renal_dxpr_or_tech",
+ 
+     "respiratory_dxpr_only",
+     "respiratory_tech_only",
+     "respiratory_dxpr_and_tech",
+     "respiratory_dxpr_or_tech",
+ 
+     "any_tech_dep",
+     "any_transplant",
+ 
+     "num_cmrb",
+     "cmrb_flag"
+   )
> 
> stopifnot(identical(names(OUT0), expected_names))
> stopifnot(identical(names(OUT1), expected_names))
> stopifnot(identical(names(OUT2), expected_names))
> 
> OUT0 <- comorbidities(data = DF0, id.vars = "pid", icd.codes = "code", method = "pccc_v3.0", poa = 1)
> OUT1 <- comorbidities(data = DF1, id.vars = "medicalcoder_id", icd.codes = "code", method = "pccc_v3.0", poa = 1)
> OUT2 <- comorbidities(data = DF2, id.vars = "..medicalcoder_id..", icd.codes = "code", method = "pccc_v3.0", poa = 1)
> 
> stopifnot(identical(names(OUT0), c("pid", expected_names)))
> stopifnot(identical(names(OUT1), c("medicalcoder_id", expected_names)))
> stopifnot(identical(names(OUT2), c("..medicalcoder_id..", expected_names)))
> 
> ################################################################################
> # Check for "protected" names in id.vars.
> #
> # During development I had been using id.vars such as:
> #
> #   id.vars = c("patid", "icd_code")
> #
> # so I could look at which codes in a patient record where flagging.
> #
> # When I tried the following
> #
> #   id.vars = c("patid", "icd_code", "icdv")
> #   icdv.var = NULL
> #   icdv = NULL
> #
> # I'd get an error becuase the "icdv" name is being used in the lookup tables and
> # gets drop in the methods and the joins in the code created a icdv.x and icdv.y
> # variable.  The code was updated so that the suffixes would be c("", ".y") to
> # fix this issue.
> #
> # for 0.0.0.9038 the following calls to comorbidities would error with the
> # following message:
> #
> #    Error in `[.data.frame`(x, r, vars, drop = drop) :
> #      undefined columns selected
> #
> # Expect that the following calls should work without error
> #
> # between 0.0.0.9044 and 0.0.0.9045 it was determined that there are some names
> # that should not be used in the id.vars, poa.var, or the primarydx.var.  Tests
> # for those are above.  The tests below would have passed for 0.0.0.9039 -
> # 0.0.0.9044, but will error for 0.0.0.9045 with a useful error message.
> mdcr$full_code <- "just a test"
> mdcr$icd_code <- mdcr$code
> 
> args <- list(data = mdcr, icd.code = "icd_code", method = "pccc_v3.0", poa = 1)
> 
> out1 <- tryCatch(do.call(comorbidities, c(args, list(id.vars = c("patid", "full_code")))), error = function(e) e)
> out2 <- tryCatch(do.call(comorbidities, c(args, list(id.vars = c("patid", "icdv")))), error = function(e) e)
> out3 <- tryCatch(do.call(comorbidities, c(args, list(id.vars = c("patid", "dx")))), error = function(e) e)
> out4 <- tryCatch(do.call(comorbidities, c(args, list(id.vars = c("patid", "code")))), error = function(e) e)
> stopifnot(
+   inherits(out1, "error"),
+   inherits(out2, "error"),
+   inherits(out3, "error"),
+   inherits(out4, "error")
+ )
> 
> ################################################################################
> #                                 End of File                                  #
> ################################################################################
> 
> proc.time()
   user  system elapsed 
   3.07    0.32    3.34