4  Params

arg_npi <- new_class(
  name    = "arg_npi",
  package = NULL,
  properties = list(
    x = new_property(
      class = new_union(NULL, class_character),
      setter = function(self, value) {
        self@x <- as.character(value[which_not_na(value)])
        self
      },
      getter = function(self) {
        as.character(self@x[which_not_na(self@x)])
      }
    ),
    op = new_property(
      class = class_character,
      default = "=",
      getter = function(self)
        if (length(self@x) > 1) "IN" else "=")
  ),
  validator = function(self) {
    if (not_null(self@x) && length(self@x) > 0) {
      assert_nchars(self@x, 10L, "npi")
      assert_digits(self@x)
      assert_luhn(self@x)
    }
  }
)

value <- c("132456789", "1324567890", "132456789", "132456789")

kit::pallv(nchar(value), value = 10L)

allv(nchar(as_chr(value)), 10L)

prop_npi <- new_property(
  class = new_union(NULL, class_character, class_numeric),
  validator = function(value) {
    if (is.null(value)) return()
    if (!allv(nchar(as_chr(value)), 10L)) "`npi` must be 10 characters long"
    if (any(stri_detect_regex(value, "^[0-9]{1,10}$"))) "`npi` must be all digits"
    if (any(!check_luhn(value))) "`npi` must pass Luhn algorithm"
    if (any(!stri_startswith(value, "[12]"))) "`npi` must start with 1 or 2"
  }
)

prop_state <- new_property(
  class = null_character,
  validator = function(value) {
    if (not_null(value)) {
      if (!is_character(value)) "`state` must be a character vector"
      if (any(sf_chars(value) != 2L)) "`state` must be 2 characters long"
      if (any(!value %in% state.abb)) {
        paste(
          "Invalid state(s) entered:",
          paste0(
            value[
              which_(value %in% state.abb, invert = TRUE)],
            collapse = ", "))
      }
    }
  }
)

class_arg

class_arg <- new_class(
  "class_arg",
  properties  = list(
    endpoint  = new_property(class_character,
    validator = function(value) { 
      if (length(value) != 1L) "must be length 1" 
      }),
    field     = new_property(NULL | class_character,
    validator = function(value) {
      if (not_null(value)) {
        if (length(value) != 1L) "must be length 1" 
      }}),
    operator = new_property(
      class_character, 
      default = "=",
      validator = function(value) {
        if (any(!value %in% c("=", ">=", "<=", ">", "<", "<>", 
                              "STARTS_WITH", "ENDS_WITH", 
                              "CONTAINS", "IN", "NOT IN", "BETWEEN", 
                              "NOT BETWEEN")
               )
           ) "@operator invalid" 
      })
  )
)

# choices = new_property(NULL | class_character,
# setter = function(self, value) {
#   self@choices <- value
#   self}),

npi <- new_class(
  name = "npi",
  parent = class_arg,
  properties = list(
    input = new_property(NULL | class_character | class_numeric),
    field = new_property(NULL | class_character,
    getter = function(self) {
      if (not_null(self@endpoint)) {
        kit::nswitch(
          self@endpoint,
          "affiliations", "npi",
          "enrollees", "NPI",
          "open_payments", "covered_recipient_npi")
        }})),
  validator = function(self) {
    if (not_null(self@input)) {
      if (!allv(nchar(as_chr(self@input)), 10L)) "`npi` must be 10 characters long"
      if (any(stri_detect_regex(self@input, "^[0-9]{1,10}$"))) "`npi` must be all digits"
      if (any(!check_luhn(as_chr(self@input)))) "`npi` must pass Luhn algorithm"
      if (any(!stri_detect_regex(self@input, "^[12]"))) "`npi` must start with 1 or 2"
    }
  }
)

npi

npi(
  endpoint = "affiliations", 
  operator = "IN",
  input = c(1043218118, 1023630738))

pac <- class_arg(
  label = "pac",
  alias = "PECOS_ASCT_CNTL_ID",
  operators = c("=", "IN", "NOT IN", "STARTS_WITH", "ENDS_WITH"))

enid <- class_arg(
  label = "enid",
  alias = "ENRLMT_ID",
  operators = c("=", "IN", "NOT IN", "STARTS_WITH", "ENDS_WITH"))

state <- class_arg(
  label = "state",
  alias = "STATE_CD",
  operators = c("=", "IN", "NOT IN", "STARTS_WITH", "ENDS_WITH"),
  choices = state.abb)

name <- class_arg(
  label = "first",
  alias = "FIRST_NAME",
  operators = c("=", "IN", "NOT IN", "STARTS_WITH", "ENDS_WITH"))

gender <- class_arg(
  label = "gender",
  alias = "GNDR_SW",
  operators = c("=", "IN", "NOT IN", "STARTS_WITH", "ENDS_WITH"),
  choices = c("M", "F", "9"))

list2(
  "NPI"                = npi,
  "PECOS_ASCT_CNTL_ID" = pac,
  "ENRLMT_ID"          = enid,
  "PROVIDER_TYPE_CD"   = spec_code,
  "PROVIDER_TYPE_DESC" = spec_desc,
  "STATE_CD"           = state,
  "FIRST_NAME"         = first,
  "MDL_NAME"           = middle,
  "LAST_NAME"          = last,
  "ORG_NAME"           = org,
  "GNDR_SW"            = gender)

class_args <- new_class(
  "class_args",
  properties = list(args = class_list))

list(
  npi = arg_npi,
  pac = arg_pac,
  enid = arg_enid,
  state = arg_state,
  first = arg_firstname,
  gender = arg_gender)

args@
  #' enrollees(enid = "I20040309000221")
  #'
  #' enrollees(npi = "1417918293", spec_code = "14-41")
  #'
  #' enrollees(pac = "2860305554", gender = "9")


try(class_args(
  id     = 1234567890,
  state  = "ZZ",
  number = "300.12"))

class_args

null_numeric    <- new_union(NULL, class_numeric)
null_vector     <- new_union(NULL, class_vector)
null_character  <- new_union(NULL, class_character)

class_args <- new_class(
  "class_args",
  properties = list(
    id     = null_numeric,
    state  = null_character,
    name   = null_character,
    number = null_numeric
  ),
  validator = function(self) { 
    if (not_null(self@state) && 
        any(!self@state %in% state.abb)) 
      paste("`state`", self@state, "not found")
  }
)

try(class_args(
  id     = 1234567890, 
  state  = "ZZ",
  number = "300.12"))

try(class_args(
  state  = "ZZ",
  name   = "Jerry",
  number = 300.12))

class_args(state  = c("GA", "MD"))

Luhn Check

rnpi <- function(n) {
  replicate(n = 10, 
            expr = cheapr::cheapr_c(1L, cheapr::sample_(0L:9L, 8L, replace = TRUE)), 
            simplify = FALSE)
}

random_npi_gen <- function(n) {
  paste0(
  1L, 
  replicate(
    n = n,
    expr = paste0(
      cheapr::sample_(0L:9L, 9L, replace = TRUE), 
      collapse = ""),
    simplify = TRUE
    )
  )
}

luhn_check <- function(x) {
  
  if (length(x) != 1L) stop("`x` must be length 1")

  i <- c(1L, 3L, 5L, 7L, 9L)
  
  d <- unlist(x, use.names = FALSE) |> 
    strsplit("") |> 
    _[[1]][-1] |> 
    cheapr::cheapr_rev() |> 
    as.integer()
  
  d[i] <- cheapr::set_multiply(d[i], 2L)
  d[i] <- cheapr::cheapr_if_else(d[i] > 9L, d[i] - 9L, d[i])
  d    <- cheapr::set_add(sum(d), 24L)
  d    <- cheapr::set_subtract(cheapr::set_multiply(cheapr::set_ceiling(d / 10L), 10L), d)

  identical(paste0(substr(x, 1, 9), d), x)
}

tictoc::tic()
exnpi <- map(random_npi_gen(100000), \(x) x[luhn_check(x)]) |> unlist(use.names = FALSE) |> length() |> print()

[1] 10095

tictoc::toc()

10.91 sec elapsed

Integer Distribution in NPIs

providertwo:::luhn_check(providertwo:::npi_ex$k[1])

luhn <- function(x) {
  
  x <- rev(
    as.integer(
      strsplit(
        unlist(
          as.character(x)
          ), 
        "")[[1]][1:9]
      )
    )
  
  idx_odd  <- seq_along(x) %% 2 == 1
  idx_even <- seq_along(x) %% 2 == 0
  
  x[idx_even] <- x[idx_even] * 2
  x[idx_even] <- ifelse(x[idx_even] > 9, x[idx_even] - 9, x[idx_even])
  
  sum_odd  <- sum(x[idx_odd])
  sum_even <- sum(x[idx_even])
  
  sum_x <- sum_odd + sum_even + 24
  
  sum_x %% 10 == 0
}

x <- providertwo:::npi_ex$k[1]

purrr::map_lgl(as.character(providertwo:::npi_ex$k), luhn)

test1 <- 1000000000:1000100000 |>
  as.character() |>
  strsplit(split = "") |>
  purrr::map(as.integer) |>
  unlist() |>
  matrix(ncol = 10, byrow = TRUE) |>
  as.data.frame()

npi_k <- providertwo:::npi_ex$k |>
  as.character() |>
  strsplit(split = "") |>
  purrr::map(as.integer) |>
  unlist() |>
  matrix(ncol = 10, byrow = TRUE) |>
  as.data.frame()

step2 <- \(x) cheapr::cheapr_if_else(x > 9L, x - 9L, x) |> as.integer()

npi_k |>
  rnm(V10 = ORIG) |>
  mtt(
    rowid = as.integer(collapse::groupid(ORIG)),
    V2 = V2 * 2,
    V4 = V4 * 2,
    V6 = V6 * 2,
    V8 = V8 * 2,
    V2 = step2(V2),
    V4 = step2(V4),
    V6 = step2(V6),
    V8 = step2(V8),
    RSUM = V1 + V2 + V3 + V4 + V5 + V6 + V7 + V8 + V9 + 24L,
    CHK = as.integer((ceiling(RSUM / 10L) * 10L) - RSUM),
    VALID = ORIG == CHK
  ) |>
  sbt(VALID == TRUE) |> 
  slt(rowid, V1:V9, V10 = CHK, checksum = RSUM) |> 
  fastplyr::as_tbl()

test9 <- 100000000:100010000 |>
  as.character() |>
  strsplit(split = "") |>
  purrr::map(as.integer) |>
  unlist() |>
  matrix(ncol = 9, byrow = TRUE) |>
  as.data.frame()

test9

step <- \(x) cheapr::cheapr_if_else(x > 9L, x - 9L, x)

test9 |>
  collapse::fmutate(across(c(V2, V4, V6, V8), function(x) step(x * 2), .apply = TRUE)) |>
  collapse::fmutate(
    RSUM = V1 + V2 + V3 + V4 + V5 + V6 + V7 + V8 + V9 + 24,
    CHK = (ceiling(RSUM / 10) * 10) - RSUM) |>
  # sbt(VALID == TRUE) |> tail()
  fcount(VALID)

library(insitu)
library(oomph)

br_seq(x = alloc_n(100000000), from = 100000000)