R/get_rxnav_relationships.R

In meerapatelmd/setupRxNorm: RxNorm and RxClass Postgres Database Management

get_rxnav_relationships <-
  function(
    class_types =
      c(
        "MESHPA",
        "EPC",
        "MOA",
        "PE",
        "PK",
        "TC",
        "VA",
        "DISEASE",
        "DISPOS",
        "CHEM",
        "SCHEDULE",
        "STRUCT"),
    prior_version = NULL,
    prior_api_version = "3.1.174") {

    version_key <-
      list(version = prior_version,
           apiVersion = prior_api_version)


    if (is.null(prior_version)) {

      version_key <- get_rxnav_api_version()

    }
  service_domain <- "https://rxnav.nlm.nih.gov"

full_path_ls <-
  list(
    pkg     = file.path(R.cache::getCacheRootPath(), "setupRxNorm"),
    version = file.path(R.cache::getCacheRootPath(), "setupRxNorm", version_key$version),
    rxclass = file.path(R.cache::getCacheRootPath(), "setupRxNorm", version_key$version, "RxClass API"),
    class_types =
      file.path(R.cache::getCacheRootPath(), "setupRxNorm", version_key$version, "RxClass API", class_types) %>%
      purrr::set_names(class_types) %>%
      as.list()
  )


dirs_ls <-
  list(
    pkg     = file.path("setupRxNorm"),
    version = file.path("setupRxNorm", version_key$version),
    rxclass = file.path("setupRxNorm", version_key$version, "RxClass API"),
    class_types =
      file.path("setupRxNorm", version_key$version, "RxClass API", class_types) %>%
      purrr::set_names(class_types) %>%
      as.list()
  )



# If the version folder was not present in the cache, it means that
# this is a brand new version
# ---
# setupRxNorm /
#     07-Feb-2022 /
#        MESHPA /
#        TC /
#        VA /
#        ...
if (!dir.exists(full_path_ls$version)) {
  pkg_dir <- full_path_ls$pkg
  cached_versions <-
    list.dirs(path = pkg_dir,
              full.names = FALSE,
              recursive = FALSE)

  if (length(cached_versions)>0) {

    cli::cli_alert_info(
      "New version {.emph {version_key$version}} is available at {.url {service_domain}}.")
    cli::cli_text(
      "Prior versions include:")
    names(cached_versions) <- "*"
    cli::cli_bullets(cached_versions)

  } else {

    cli::cli_alert_info(
      "First cache created with version {.emph {version_key$version}}.")


  }

}

http_request <-
  "/REST/rxclass/relaSources.json"

url <-
  paste0(
    service_domain,
    http_request
  )


key <-
  list(
    version_key,
    url
  )

rels_df <-
  R.cache::loadCache(
    dirs = dirs_ls$version,
    key = key
  )


if (is.null(rels_df)) {
  resp <-
    httr::GET(url = url)


  abort_on_api_error(response = resp)

  rels_df <-
    httr::content(resp) %>%
    purrr::pluck("relaSourceList") %>%
    purrr::pluck("relaSourceName") %>%
    unlist() %>%
    tibble::as_tibble_col()

  names(rels_df) <- "relaSource"

  if (is.null(rels_df)) {

    cli::cli_abort("Classes could not be collected.")

  }

  R.cache::saveCache(
    dirs = dirs_ls$version,
    key = key,
    object = rels_df
  )

  rels_df <-
    R.cache::loadCache(
      dirs = dirs_ls$version,
      key = key
    )
}


  rels_df
  }