Cse

R/CodelistFromCodelistWithDetails.R

@@ -0,0 +1,18 @@
+
+
+codelistFromCodelistWithDetails <- function(x){
+
+  if(isFALSE(inherits(x, "codelist_with_details"))){
+    cli::cli_abort("x is not class codelist_with_details but {class(x)}")
+  }
+
+  for(i in seq_along(x)){
+    x[[i]] <- x[[i]] |>
+      dplyr::pull("concept_id")
+  }
+
+  x <- omopgenerics::newCodelist(x)
+
+  x
+
+}

R/codesFromConceptSet.R

@@ -14,13 +14,13 @@
 # See the License for the specific language governing permissions and
 # limitations under the License.
 
+
 #' Get concept ids from a provided path to json files
 #'
 #' @param path Path to a file or folder containing JSONs of concept sets
 #' @param cdm A cdm reference created with CDMConnector
-#' @param withConceptDetails If FALSE a vector of concept IDs will be returned
-#' for each concept set. If TRUE a tibble will be returned with additional
-#' information on the identified concepts.
+#' @param type Can be "codelist", "codelist_with_details", or
+#' "concept_set_expression"
 #'
 #' @return Named list with concept_ids for each concept set
 #' @export
@@ -34,7 +34,11 @@
 #' x
 #' CDMConnector::cdmDisconnect(cdm)
 #' }
-codesFromConceptSet <- function(path, cdm, withConceptDetails = FALSE) {
+codesFromConceptSet <- function(path,
+                                cdm,
+                                type = c("codelist")) {
+
+
   # initial checks
   checkInputs(path = path, cdm = cdm)
 
@@ -67,6 +71,28 @@ codesFromConceptSet <- function(path, cdm, withConceptDetails = FALSE) {
     }
   )
 
+  if(type == "concept_set_expression"){
+    conceptList <- conceptList |>
+    dplyr::select("concept_id",
+                  "excluded" = "is_excluded",
+                  "descendants" = "include_descendants",
+                  "mapped" = "include_mapped",
+                  "cohort_name")
+
+    conceptList <- split(
+      conceptList,
+      conceptList[, c("cohort_name")]
+    )
+
+    for(j in seq_along(conceptList)){
+      conceptList[[j]] <- conceptList[[j]] |>
+        dplyr::select(!"cohort_name")
+    }
+    conceptList <- omopgenerics::newConceptSetExpression(conceptList)
+    return(conceptList)
+    }
+
+
   if(any(conceptList$include_mapped == TRUE)){
     exc <- paste(conceptList %>%
                    dplyr::filter(.data$include_mapped == TRUE) %>%
@@ -90,11 +116,18 @@ codesFromConceptSet <- function(path, cdm, withConceptDetails = FALSE) {
   conceptFinalList <- formatConceptList(cdm = cdm,
                                         conceptListTable = conceptListTable)
 
-  if(isTRUE(withConceptDetails)){
+  if(type == "codelist"){
+    conceptFinalList <- omopgenerics::newCodelist(conceptFinalList)
+  }
+
+  if(type == "codelist_with_details"){
     conceptFinalList <- addDetails(conceptList = conceptFinalList,
                cdm = cdm)
+    conceptFinalList <- omopgenerics::newCodelistWithDetails(conceptFinalList)
   }
 
+
+
   # return list
   return(conceptFinalList)
 }
@@ -103,14 +136,15 @@ codesFromConceptSet <- function(path, cdm, withConceptDetails = FALSE) {
 #'
 #' @param path Path to a file or folder containing JSONs of cohort definitions
 #' @param cdm A cdm reference created with CDMConnector
-#' @param withConceptDetails If FALSE a vector of concept IDs will be returned
-#' for each concept set. If TRUE a tibble will be returned with additional
-#' information on the identified concepts.
+#' @param type Can be "codelist", "codelist_with_details", or
+#' "concept_set_expression"
 #'
 #' @return Named list with concept_ids for each concept set
 #' @export
 #'
-codesFromCohort <- function(path, cdm, withConceptDetails = FALSE) {
+codesFromCohort <- function(path,
+                            cdm,
+                            type = c("codelist")) {
   # initial checks
   checkInputs(path = path, cdm = cdm)
 
@@ -129,6 +163,29 @@ codesFromCohort <- function(path, cdm, withConceptDetails = FALSE) {
     cli::cli_abort("No codes found")
   }
 
+  if(type == "concept_set_expression"){
+    codelistTibble <- codelistTibble |>
+      dplyr::mutate(include_mapped = FALSE) |>
+      dplyr::select("concept_id",
+                    "excluded" = "is_excluded",
+                    "descendants" = "include_descendants",
+                    "mapped" = "include_mapped",
+                    "codelist_name")
+
+    codelistTibble <- split(
+      codelistTibble,
+      codelistTibble[, c("codelist_name")]
+    )
+
+    for(j in seq_along(codelistTibble)){
+      codelistTibble[[j]] <- codelistTibble[[j]] |>
+        dplyr::select(!"codelist_name")
+    }
+    codelistTibble <- omopgenerics::newConceptSetExpression(codelistTibble)
+    return(codelistTibble)
+  }
+
+
   codelistTable <- omopgenerics::uniqueTableName()
   cdm <- omopgenerics::insertTable(cdm = cdm,
                                    name = codelistTable,
@@ -151,11 +208,17 @@ codesFromCohort <- function(path, cdm, withConceptDetails = FALSE) {
   # split into list
   codelist <- tibbleToList(codelistTibble)
 
-  if(isTRUE(withConceptDetails)){
+  if(type == "codelist"){
+    codelist <- omopgenerics::newCodelist(codelist)
+  }
+
+  if(type == "codelist_with_details"){
     codelist <- addDetails(conceptList = codelist,
                                    cdm = cdm)
+    codelist <- omopgenerics::newCodelistWithDetails(codelist)
   }
 
+
   # return
   return(codelist)
 }

R/drugCodes.R

@@ -263,8 +263,9 @@ getDrugIngredientCodes <- function(cdm,
   }
       ingredientCodes <- ingredientCodes  %>%
         dplyr::select("concept_id", "concept_name",
-                        "domain_id", "vocabulary_id",
-                        "ancestor_concept_id") %>%
+                      "domain_id", "vocabulary_id",
+                      "standard_concept",
+                      "ancestor_concept_id") %>%
       # split different ancestors into multiple cols
       tidyr::separate_wider_delim(
         cols = "ancestor_concept_id",
@@ -276,7 +277,8 @@ getDrugIngredientCodes <- function(cdm,
     ingredientCodes <- ingredientCodes %>%
       # one row per concept + ancestor
       tidyr::pivot_longer(cols = !c("concept_id", "concept_name",
-                                    "domain_id", "vocabulary_id"),
+                                    "domain_id", "vocabulary_id",
+                                    "standard_concept"),
         names_to = NULL,
         values_to = "ancestor_concept_id",
         values_drop_na = TRUE
@@ -322,8 +324,8 @@ getDrugIngredientCodes <- function(cdm,
 
     if(!is.null(routeCategory)){
       ingredientCodes <- subsetOnRouteCategory(ingredientCodes,
-                            cdm = cdm,
-                            routeCategory = routeCategory)
+                                               cdm = cdm,
+                                               routeCategory = routeCategory)
     }
 
     return(ingredientCodes)

R/stratifyByRoute.R

@@ -27,6 +27,14 @@
 #'
 stratifyByRouteCategory <- function(x, cdm, keepOriginal = FALSE){
 
+  if(inherits(x, "codelist_with_details")){
+    x_original <- x
+    withDetails <- TRUE
+    x <- codelistFromCodelistWithDetails(x)
+  } else {
+    withDetails <- FALSE
+  }
+
   x <- omopgenerics::newCodelist(x)
 
   if(isFALSE(inherits(cdm, "cdm_reference"))){
@@ -70,6 +78,12 @@ stratifyByRouteCategory <- function(x, cdm, keepOriginal = FALSE){
       dplyr::distinct() |>
       dplyr::collect()
 
+    if(isTRUE(withDetails)){
+      workingCodesWithRoute <-  x_original[[i]] |>
+          dplyr::inner_join(workingCodesWithRoute,
+                            by = "concept_id")
+    }
+
     workingCodesWithRoute <- split(
       workingCodesWithRoute,
       workingCodesWithRoute[, c("route_category")]
@@ -78,12 +92,15 @@ stratifyByRouteCategory <- function(x, cdm, keepOriginal = FALSE){
     names(workingCodesWithRoute) <- paste0(workingName, "_",
                                            names(workingCodesWithRoute))
 
+    if(isFALSE(withDetails)){
     for(j in seq_along(workingCodesWithRoute)){
       workingCodesWithRoute[[j]] <- sort(workingCodesWithRoute[[j]] |>
                                            dplyr::pull("concept_id"))
-    }
+
+    }}
 
     result[[i]] <- workingCodesWithRoute
+
   }
 
   result <- purrr::list_flatten(result) |>
@@ -95,6 +112,13 @@ stratifyByRouteCategory <- function(x, cdm, keepOriginal = FALSE){
 
   CDMConnector::dropTable(cdm = cdm, name = tableCodelist)
 
+
+  if(isFALSE(withDetails)){
+    result <- omopgenerics::newCodelist(result)
+  } else{
+    result <- omopgenerics::newCodelistWithDetails(result)
+  }
+
   result
 
 }

R/subsetOnRouteCategory.R

@@ -27,6 +27,14 @@
 #'
 subsetOnRouteCategory <- function(x, cdm, routeCategory){
 
+  if(inherits(x, "codelist_with_details")){
+    x_original <- x
+    withDetails <- TRUE
+    x <- codelistFromCodelistWithDetails(x)
+  } else {
+    withDetails <- FALSE
+  }
+
   x <- omopgenerics::newCodelist(x)
 
   if(isFALSE(inherits(cdm, "cdm_reference"))){
@@ -71,6 +79,10 @@ subsetOnRouteCategory <- function(x, cdm, routeCategory){
 
     x[[i]] <- sort(x[[i]])
 
+    if(isTRUE(withDetails)){
+      x[[i]] <- x_original[[i]] |>
+        dplyr::filter(.data$concept_id %in% x[[i]])
+    }
   }
 
    x <- x |>