Merge pull request #94 from OHDSI/develop

Develop v2.0.8

Author: mdlavallee92

DESCRIPTION

@@ -1,9 +1,9 @@
 Package: Capr
 Title: Cohort Definition Application Programming
-Version: 2.0.7
+Version: 2.0.8
 Authors@R: c(
-    person("Martin", "Lavallee", , "martin.lavallee@odysseusinc.com", role = c("aut")),
-    person("Adam", "Black", , "black@ohdsi.org", role = c("aut", "cre"))
+    person("Martin", "Lavallee", , "martin.lavallee@boehringer-ingelheim.com", role = c("aut", "cre")),
+    person("Adam", "Black", , "black@ohdsi.org", role = c("aut"))
   )
 Description: Provides a programming language for defining cohort definitions in R to use in studies for Observational 
     Health Data Sciences and Informatics (OHDSI). The functions in 'Capr' allow for the programmatic creation of 
@@ -16,10 +16,9 @@ License: Apache License (>= 2)
 URL: https://ohdsi.github.io/Capr/, https://github.com/OHDSI/Capr/
 BugReports: https://github.com/OHDSI/Capr/issues/
 Encoding: UTF-8
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Depends: 
-  R (>= 3.5.0),
-  CirceR (>= 1.3.1)
+  R (>= 3.5.0)
 Imports: 
     magrittr (>= 1.5.0),
     jsonlite,
@@ -40,16 +39,14 @@ Imports:
     DBI,
     DatabaseConnector,
     SqlRender,
-    generics
+    generics,
+    CirceR
 Suggests:
     testthat (>= 3.0.0),
     knitr,
     rmarkdown
-Remotes:
-    ohdsi/CirceR
 VignetteBuilder: knitr
 Config/testthat/edition: 3
-Additional_repositories: https://OHDSI.github.io/drat
 Collate: 
     'Capr.R'
     'conceptSet.R'

NAMESPACE

@@ -13,17 +13,20 @@ export(cohort)
 export(compile)
 export(conditionEra)
 export(conditionOccurrence)
+export(conditionType)
 export(continuousObservation)
 export(cs)
 export(dateAdjustment)
 export(daysOfSupply)
 export(death)
 export(descendants)
+export(deviceExposure)
 export(drugEra)
 export(drugExit)
 export(drugExposure)
 export(drugQuantity)
 export(drugRefills)
+export(drugType)
 export(duringInterval)
 export(endDate)
 export(entry)
@@ -46,14 +49,17 @@ export(makeCohortSet)
 export(male)
 export(mapped)
 export(measurement)
+export(measurementType)
 export(nbt)
 export(nestedWithAll)
 export(nestedWithAny)
 export(nestedWithAtLeast)
 export(nestedWithAtMost)
 export(observation)
 export(observationExit)
+export(observationType)
 export(procedure)
+export(procedureType)
 export(rangeHigh)
 export(rangeLow)
 export(readConceptSet)
@@ -62,6 +68,7 @@ export(toCirce)
 export(unit)
 export(valueAsNumber)
 export(visit)
+export(visitType)
 export(withAll)
 export(withAny)
 export(withAtLeast)

NEWS.md

@@ -1,3 +1,10 @@
+Capr 2.0.8
+==========
+- add conceptTypes to determine data provenance #93
+- allow numeric as offsetDays #90
+- add deviceExposure #86
+- other minor edits
+
 Capr 2.0.7
 ==========
 - add CirceR in REMOTES section

R/Capr.R

@@ -1,4 +1,4 @@
-# Copyright 2023 Observational Health Data Sciences and Informatics
+# Copyright 2024 Observational Health Data Sciences and Informatics
 #
 # This file is part of Capr
 #

R/attributes-concept.R

@@ -79,6 +79,128 @@ female <- function() {
 }
 
 
+findConceptInVocabulary <- function(id, connection, vocabularyDatabaseSchema) {
+
+  detailedConceptSet <- cs(id, name = glue::glue("{id}")) |>
+    getConceptSetDetails(con = connection,
+                         vocabularyDatabaseSchema = vocabularyDatabaseSchema)
+  return(detailedConceptSet)
+}
+
+pullConceptClass <- function(detailedConceptSet) {
+  conceptClass <- detailedConceptSet@Expression[[1]]@Concept
+  return(conceptClass)
+}
+
+buildConceptAttribute <- function(ids, attributeName, connection, vocabularyDatabaseSchema) {
+
+  # get concepts from vocabulary table
+  conceptsForAttributes <- purrr::map(
+    ids,
+    ~findConceptInVocabulary(id = .x, connection = connection, vocabularyDatabaseSchema = vocabularyDatabaseSchema) |>
+      pullConceptClass()
+  )
+
+  attr_concept <- methods::new("conceptAttribute",
+                               name = attributeName,
+                               conceptSet = conceptsForAttributes)
+  return(attr_concept)
+}
+
+#' Add a drug type attribute to determine the provenance of the record
+#' @param ids the concept ids for the attribute
+#' @param connection a connection to an OMOP dbms to get vocab info about the concept
+#' @param vocabularyDatabaseSchema the database schema for the vocabularies
+#' @return
+#' An attribute that can be used in a query function
+#' @export
+#'
+drugType <- function(ids, connection, vocabularyDatabaseSchema) {
+  res <- buildConceptAttribute(ids = ids, attributeName = "DrugType",
+                        connection = connection,
+                        vocabularyDatabaseSchema = vocabularyDatabaseSchema)
+  return(res)
+}
+
+#' Add a condition type attribute to determine the provenance of the record
+#' @param ids the concept ids for the attribute
+#' @param connection a connection to an OMOP dbms to get vocab info about the concept
+#' @param vocabularyDatabaseSchema the database schema for the vocabularies
+#' @return
+#' An attribute that can be used in a query function
+#' @export
+#'
+conditionType <- function(ids, connection, vocabularyDatabaseSchema) {
+  res <- buildConceptAttribute(ids = ids, attributeName = "ConditionType",
+                               connection = connection,
+                               vocabularyDatabaseSchema = vocabularyDatabaseSchema)
+  return(res)
+}
+
+
+
+#' Add a visit type attribute to determine the provenance of the record
+#' @param ids the concept ids for the attribute
+#' @param connection a connection to an OMOP dbms to get vocab info about the concept
+#' @param vocabularyDatabaseSchema the database schema for the vocabularies
+#' @return
+#' An attribute that can be used in a query function
+#' @export
+#'
+visitType <- function(ids, connection, vocabularyDatabaseSchema) {
+  res <- buildConceptAttribute(ids = ids, attributeName = "VisitType",
+                               connection = connection,
+                               vocabularyDatabaseSchema = vocabularyDatabaseSchema)
+  return(res)
+}
+
+
+#' Add a measurement type attribute to determine the provenance of the record
+#' @param ids the concept ids for the attribute
+#' @param connection a connection to an OMOP dbms to get vocab info about the concept
+#' @param vocabularyDatabaseSchema the database schema for the vocabularies
+#' @return
+#' An attribute that can be used in a query function
+#' @export
+#'
+measurementType <- function(ids, connection, vocabularyDatabaseSchema) {
+  res <- buildConceptAttribute(ids = ids, attributeName = "measurementType",
+                               connection = connection,
+                               vocabularyDatabaseSchema = vocabularyDatabaseSchema)
+  return(res)
+}
+
+#' Add a observation type attribute to determine the provenance of the record
+#' @param ids the concept ids for the attribute
+#' @param connection a connection to an OMOP dbms to get vocab info about the concept
+#' @param vocabularyDatabaseSchema the database schema for the vocabularies
+#' @return
+#' An attribute that can be used in a query function
+#' @export
+#'
+observationType <- function(ids, connection, vocabularyDatabaseSchema) {
+  res <- buildConceptAttribute(ids = ids, attributeName = "observationType",
+                               connection = connection,
+                               vocabularyDatabaseSchema = vocabularyDatabaseSchema)
+  return(res)
+}
+
+
+#' Add a procedure type attribute to determine the provenance of the record
+#' @param ids the concept ids for the attribute
+#' @param connection a connection to an OMOP dbms to get vocab info about the concept
+#' @param vocabularyDatabaseSchema the database schema for the vocabularies
+#' @return
+#' An attribute that can be used in a query function
+#' @export
+#'
+procedureType <- function(ids, connection, vocabularyDatabaseSchema) {
+  res <- buildConceptAttribute(ids = ids, attributeName = "procedureType",
+                               connection = connection,
+                               vocabularyDatabaseSchema = vocabularyDatabaseSchema)
+  return(res)
+}
+
 #' Add unit attribute to a query
 #' @param x   A single character idetifier for a unit or a concept set that identifies units
 #' @return
@@ -121,7 +243,7 @@ unit <- function(x) {
 
   # conceptSet <- as.list(as.data.frame(conceptSet)$conceptId) conceptSet <- as.list(conceptSet)
 
-  res <- methods::new("conceptAttribute", name = "unit", conceptSet = conceptSet)
+  res <- methods::new("conceptAttribute", name = "Unit", conceptSet = conceptSet)
   return(res)
 }
 
@@ -130,7 +252,7 @@ unit <- function(x) {
 setMethod("as.list", "conceptAttribute", function(x) {
 
   concepts <- purrr::map(x@conceptSet, ~as.list(.x))
-  nm <- stringr::str_to_title(x@name)
+  nm <- x@name
 
   tibble::lst(`:=`(!!nm, concepts))
 })

R/exit.R

@@ -141,7 +141,7 @@ drugExit <- function(conceptSet,
 
 #' Function to create an exit based on exit based on the end of a continuous drug exposure
 #' @param index specification of event date to offset. Can be either startDate or endDate
-#' @param offsetDays an integer specifying the number of days to offset from the event date
+#' @param offsetDays an number specifying the days to offset from the event date. Will coerce to an integer
 #' @return a fixed Duration exit S4 object used to define the cohort exit as the end of a specified time
 #' @export
 fixedExit <- function(index = c("startDate", "endDate"), offsetDays){
@@ -150,7 +150,7 @@ fixedExit <- function(index = c("startDate", "endDate"), offsetDays){
 
   ee <- methods::new("FixedDurationExit",
       index = index,
-      offsetDays = offsetDays)
+      offsetDays = as.integer(offsetDays))
   return(ee)
 }
 

R/query.R

@@ -136,6 +136,21 @@ drugExposure <- function(conceptSet, ...) {
         ...)
 }
 
+
+#' Query the drug domain
+#'
+#' @param conceptSet A drug concept set
+#' @param ... optional attributes
+#'
+#' @return A Capr Query
+#' @export
+deviceExposure <- function(conceptSet, ...) {
+
+  query(domain = "DeviceExposure",
+        conceptSet = conceptSet,
+        ...)
+}
+
 #' Query the measurement domain
 #'
 #' @param conceptSet A measurement concept set