add dateAdjustment attribute

NAMESPACE

@@ -15,6 +15,7 @@ export(conditionEra)
 export(conditionOccurrence)
 export(continuousObservation)
 export(cs)
+export(dateAdjustment)
 export(daysOfSupply)
 export(death)
 export(descendants)

R/attributes-dateAdjustment.R

@@ -0,0 +1,62 @@
+# date Adjustment Attribute
+
+
+# Class ----------------------------
+
+#' An S4 class for a date adjustment attribute
+#' @slot name the name of the attribute
+#' @slot startWith character string either START_DATE or END_DATE
+#' @slot startOffset an integer value, default 0
+#' @slot endWith character string either START_DATE or END_DATE
+#' @slot endOffset an integer value, default 0
+setClass("dateAdjustmentAttribute",
+         slots = c(name = "character",
+                   startWith = "character",
+                   startOffset = "integer",
+                   endWith = "character",
+                   endOffset = "integer"
+         ),
+         prototype = list(
+           name = "DateAdjustment",
+           startWith = "START_DATE",
+           startOffset = 0L,
+           endWith = "END_DATE",
+           endOffset = 0L
+         )
+)
+
+# Builder -----------------
+
+#' Function to create age attribute
+#' @param startWith character string either START_DATE or END_DATE
+#' @param startOffset an integer value, default 0
+#' @param endWith character string either START_DATE or END_DATE
+#' @param endOffset an integer value, default 0
+#' @return A dateAdjustment attribute class that can be used with a query
+#' @export
+dateAdjustment <- function(startWith = "START_DATE",
+                           startOffset = 0L,
+                           endWith = "END_DATE",
+                           endOffset = 0L) {
+
+
+  methods::new("dateAdjustmentAttribute",
+               startWith = startWith,
+               startOffset = startOffset,
+               endWith = endWith,
+               endOffset = endOffset)
+
+}
+
+# Coercion --------------
+
+setMethod("as.list", "dateAdjustmentAttribute", function(x) {
+
+  atr <- list(
+    StartWith = x@startWith,
+    StartOffset = x@startOffset,
+    EndWith = x@endWith,
+    EndOffset = x@endOffset)
+
+  tibble::lst(`:=`(!!x@name, atr))
+})

tests/testthat/test-attributes.R

@@ -255,3 +255,21 @@ test_that("logical attributes build", {
   expect_named(t2, "First")
   expect_equal(t2$First, TRUE)
 })
+
+
+
+test_that("dateAdjustment attributes build", {
+
+  t1 <- dateAdjustment(startWith = "START_DATE",
+                       startOffset = 30L,
+                       endWith = "END_DATE",
+                       endOffset = 30L)
+  expect_s4_class(t1, "dateAdjustmentAttribute")
+  expect_equal(t1@name, "DateAdjustment")
+  expect_equal(t1@startOffset, 30L)
+
+
+  t2 <- as.list(t1)
+  expect_named(t2, "DateAdjustment")
+  expect_equal(t2$DateAdjustment$StartOffset, 30L)
+})