add api_all_code_systems, api_code_system, api_code_system_all_versions

#2

NAMESPACE

@@ -1,13 +1,16 @@
 # Generated by roxygen2: do not edit by hand
 
 export(api_all_branches)
+export(api_all_code_systems)
 export(api_branch)
 export(api_branch_descendants)
 export(api_browser_concept_ancestors)
 export(api_browser_concept_children)
 export(api_browser_concept_descriptions)
 export(api_browser_concept_parents)
 export(api_browser_concepts)
+export(api_code_system)
+export(api_code_system_all_versions)
 export(api_concept)
 export(api_concept_descendants)
 export(api_concept_descriptions)

R/rest-api.R

@@ -60,6 +60,8 @@
 #' @param form a character string indicating which ancestors/parents or
 #' descendants/children to extract based on stated or inferred relationships.
 #' Must be one of \code{"inferred"} (default), \code{"stated"}, or \code{"additional"}.
+#' @param forBranch a character name of a single branch (eg \code{"MAIN"}) for which
+#' to fetch code systems results. The default (\code{NULL}) will return all code systems.
 #' @param groupByConcept a boolean indicating whether to group descriptions
 #' by concept. Default is \code{FALSE}.
 #' @param includeDescendantCount a boolean indicating whether a number of
@@ -89,6 +91,11 @@
 #' to include (example: \code{c("attribute", "finding")}). See
 #' \code{api_descriptions_semantic_tags()} for a list of valid
 #' description semantic tags.
+#' @param shortName character name of a code system (eg \code{"SNOMEDCT"},
+#' \code{"SNOMEDCT-UK"})
+#' @param showFutureVersions a boolean indicating whether to include all code
+#' systems (\code{NULL}, the default), only future code systems (\code{TRUE}),
+#' or no future code systems (\code{FALSE})
 #' @param source a character vector of concepts to be included as
 #' sources defined by the relationship
 #' @param stated a boolean indicating whether to limit search to descendants
@@ -754,4 +761,88 @@ api_relationship <- function(
 }
 
 
+#' @rdname api_operations
+#' @export
+api_all_code_systems <- function(endpoint = snomedizer_options_get("endpoint"),
+                                 forBranch = NULL,
+                                 catch404 = TRUE) {
+
+  if( !is.null(forBranch) ) {
+    stopifnot(length(forBranch) == 1)
+    stopifnot(is.character(forBranch))
+  }
+
+  rest_url <- httr::parse_url(endpoint)
+  rest_url$path <- c(rest_url$path[rest_url$path != ""],
+                     "codesystems")
+  rest_url$query <- list(
+    forBranch = forBranch
+  )
+  rest_url <- httr::build_url(rest_url)
+  rest_result <- GET(rest_url)
+
+  if(catch404){
+    .catch_http_error(rest_result)
+  }
+
+  rest_result
+}
+
+
+#' @rdname api_operations
+#' @export
+api_code_system <- function(endpoint = snomedizer_options_get("endpoint"),
+                            shortName,
+                            catch404 = TRUE) {
+
+  stopifnot(length(shortName) == 1)
+  stopifnot(is.character(shortName))
+
+  rest_url <- httr::parse_url(endpoint)
+  rest_url$path <- c(rest_url$path[rest_url$path != ""],
+                     "codesystems",
+                     shortName)
+  rest_url <- httr::build_url(rest_url)
+  rest_result <- GET(rest_url)
+
+  if(catch404){
+    .catch_http_error(rest_result)
+  }
+
+  rest_result
+}
+
+
+#' @rdname api_operations
+#' @export
+api_code_system_all_versions <- function(endpoint = snomedizer_options_get("endpoint"),
+                                         shortName,
+                                         showFutureVersions = NULL,
+                                         catch404 = TRUE) {
+  stopifnot(length(shortName) == 1)
+  stopifnot(is.character(shortName))
+
+  if( !is.null(showFutureVersions) ) {
+    stopifnot(length(showFutureVersions)==1)
+    stopifnot(is.logical(showFutureVersions))
+  }
+
+  rest_url <- httr::parse_url(endpoint)
+  rest_url$path <- c(rest_url$path[rest_url$path != ""],
+                     "codesystems",
+                     shortName,
+                     "versions")
+  rest_url$query <- list(
+    showFutureVersions = showFutureVersions
+  )
+  rest_url <- httr::build_url(rest_url)
+  rest_result <- GET(rest_url)
+
+  if(catch404){
+    .catch_http_error(rest_result)
+  }
+
+  rest_result
+}
+
 

tests/testthat/test.rest-api.R

@@ -265,3 +265,37 @@ test_that("api_relationship", {
   expect_equal(is_a$type.conceptId, "116680003")
   expect_equal(is_a$target.conceptId, "50417007")
 })
+
+
+# api_all_code_systems ----------------------------------------------------
+
+test_that("api_all_code_systems", {
+  expect_error(api_all_code_systems(forBranch = c(1, 2)))
+  expect_true("SNOMEDCT" %in% result_flatten(api_all_code_systems())$shortName)
+  expect_equal(
+    result_flatten(api_all_code_systems(forBranch = "MAIN"))$shortName,
+    "SNOMEDCT"
+  )
+})
+
+
+# api_code_system ---------------------------------------------------------
+
+test_that("api_code_system", {
+  expect_error(api_code_system(shortName = NULL))
+  expect_error(api_code_system(shortName = c("a", "b")))
+  expect_true(
+    "SNOMEDCT" %in% result_flatten(api_code_system(shortName = "SNOMEDCT"))$shortName
+  )
+})
+
+
+# api_code_system_all_versions --------------------------------------------
+
+test_that("api_code_system_all_versions", {
+  expect_error(api_code_system_all_versions(shortName = NULL))
+  expect_error(api_code_system_all_versions(shortName = c("a", "b")))
+  expect_true(
+    "SNOMEDCT" %in% result_flatten(api_code_system_all_versions(shortName = "SNOMEDCT"))$shortName
+  )
+})