From b4bce8fe29960ef08b0520504b85be3c6ca13be8 Mon Sep 17 00:00:00 2001 From: Peter Dutey Date: Wed, 18 Nov 2020 12:17:09 +0000 Subject: [PATCH] add api_all_code_systems, api_code_system, api_code_system_all_versions #2 --- NAMESPACE | 3 ++ R/rest-api.R | 91 ++++++++++++++++++++++++++++++++++ man/api_operations.Rd | 32 ++++++++++++ tests/testthat/test.rest-api.R | 34 +++++++++++++ 4 files changed, 160 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 0186c2b..7ac5962 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,7 @@ # 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) @@ -8,6 +9,8 @@ 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) diff --git a/R/rest-api.R b/R/rest-api.R index 5834954..ee14f32 100644 --- a/R/rest-api.R +++ b/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 +} + diff --git a/man/api_operations.Rd b/man/api_operations.Rd index 409d450..ca0d08b 100644 --- a/man/api_operations.Rd +++ b/man/api_operations.Rd @@ -19,6 +19,9 @@ \alias{api_descriptions_semantic_tags} \alias{api_relationships} \alias{api_relationship} +\alias{api_all_code_systems} +\alias{api_code_system} +\alias{api_code_system_all_versions} \title{SNOMED CT Terminology Server REST API operations} \usage{ api_concept( @@ -173,6 +176,25 @@ api_relationship( catch404 = TRUE, ... ) + +api_all_code_systems( + endpoint = snomedizer_options_get("endpoint"), + forBranch = NULL, + catch404 = TRUE +) + +api_code_system( + endpoint = snomedizer_options_get("endpoint"), + shortName, + catch404 = TRUE +) + +api_code_system_all_versions( + endpoint = snomedizer_options_get("endpoint"), + shortName, + showFutureVersions = NULL, + catch404 = TRUE +) } \arguments{ \item{conceptId}{character string of a SNOMED-CT concept id (for example: @@ -307,6 +329,16 @@ This parameter corresponds to \code{ 900000000000449001 | Characteristic type (core metadata concept)}} \item{relationshipId}{string of a relationship concept} + +\item{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.} + +\item{shortName}{character name of a code system (eg \code{"SNOMEDCT"}, +\code{"SNOMEDCT-UK"})} + +\item{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})} } \value{ An \code{httr} \code{\link[httr]{response}()} object. diff --git a/tests/testthat/test.rest-api.R b/tests/testthat/test.rest-api.R index 026a1e8..1531ecb 100644 --- a/tests/testthat/test.rest-api.R +++ b/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 + ) +})