format dates in test data tab

R/patientsDesigner.R

@@ -137,7 +137,6 @@ patientDesigner <- function(path = NULL) {
         tabPanel(
           "Test Data",
           tableOutput("cdmData"),
-          # verbatimTextOutput("cdmData"),
           tableOutput("personDataTable"),
           tableOutput("observationPeriodTable"),
           tableOutput("drugExposureTable"),
@@ -379,7 +378,7 @@ patientDesigner <- function(path = NULL) {
       observation_period_module$add_click()
       observation_period_module$delete_click()
       observation_period_module$elongation_click()
-      cdm$observation_period$data()
+      formatDateColumns(cdm$observation_period$data())
     })
 
     ##### DRUG EXPOSURE TABLE
@@ -398,7 +397,7 @@ patientDesigner <- function(path = NULL) {
       drug_exposure_module$add_click()
       drug_exposure_module$delete_click()
       drug_exposure_module$elongation_click()
-      cdm$drug_exposure$data()
+      formatDateColumns(cdm$drug_exposure$data())
     })
 
     # CONDITION OCCURRENCE TABLE
@@ -415,7 +414,7 @@ patientDesigner <- function(path = NULL) {
       condition_occurrence_module$add_click()
       condition_occurrence_module$delete_click()
       condition_occurrence_module$elongation_click()
-      cdm$condition_occurrence$data()
+      formatDateColumns(cdm$condition_occurrence$data())
     })
 
     # MEASUREMENT TABLE
@@ -431,7 +430,7 @@ patientDesigner <- function(path = NULL) {
       measurement_module$add_click()
       measurement_module$delete_click()
       measurement_module$elongation_click()
-      cdm$measurement$data()
+      formatDateColumns(cdm$measurement$data())
     })
 
     # PROCEDURE OCCURRENCE TABLE
@@ -447,7 +446,7 @@ patientDesigner <- function(path = NULL) {
       procedure_occurrence_module$add_click()
       procedure_occurrence_module$delete_click()
       procedure_occurrence_module$elongation_click()
-      cdm$procedure_occurrence$data()
+      formatDateColumns(cdm$procedure_occurrence$data())
     })
 
     # OBSERVATION TABLE
@@ -470,7 +469,7 @@ patientDesigner <- function(path = NULL) {
     cdmDataTimeline <- reactive({
       pid <- suppressWarnings(as.numeric(person_module()))
       req(!is.na(pid), length(pid) == 1)
-      # browser()
+
       cdm$getCdmDataTimeline() %>%
         dplyr::filter(.data$person_id == pid)
     }) %>% bindEvent(
@@ -500,7 +499,7 @@ patientDesigner <- function(path = NULL) {
     # Render cdm table
     output$cdmData <- renderTable({
       req(cdmDataTimeline)
-      cdmDataTimeline()
+      formatDateColumns(cdmDataTimeline())
     })
 
     ## UPDATE DATA FROM D3

R/timelineHelpers.R

@@ -22,3 +22,41 @@ normalizeBarEndUpdate <- function(update_data) {
 
   update_data
 }
+
+formatDateColumns <- function(data) {
+  date_cols <- names(data)[
+    names(data) %in% c("start_date", "end_date") |
+      grepl("_date$", names(data))
+  ]
+  if (length(date_cols) == 0) {
+    return(data)
+  }
+
+  data <- as.data.frame(data)
+  for (date_col in date_cols) {
+    data[[date_col]] <- formatDateColumn(data[[date_col]])
+  }
+
+  data
+}
+
+formatDateColumn <- function(x) {
+  if (inherits(x, "Date")) {
+    return(as.character(x))
+  }
+
+  if (inherits(x, c("POSIXct", "POSIXlt"))) {
+    return(format(as.Date(x, tz = "UTC"), "%Y-%m-%d"))
+  }
+
+  if (is.numeric(x)) {
+    return(as.character(as.Date(x, origin = "1970-01-01")))
+  }
+
+  parsed <- suppressWarnings(as.Date(x))
+  if (all(is.na(x) | !is.na(parsed))) {
+    return(as.character(parsed))
+  }
+
+  as.character(x)
+}

tests/testthat/helper-internals.R

@@ -8,4 +8,5 @@ new_cdm_table <- function(type) {
 
 cdm_table_server <- getFromNamespace("cdmTableServer", "PatientGenerator")
 normalize_bar_end_update <- getFromNamespace("normalizeBarEndUpdate", "PatientGenerator")
+format_date_columns <- getFromNamespace("formatDateColumns", "PatientGenerator")
 hecate_concept_label <- getFromNamespace("hecateConceptLabel", "PatientGenerator")

tests/testthat/test-timelineHelpers.R

@@ -30,3 +30,52 @@ test_that("normalizeBarEndUpdate leaves measurement end date untouched", {
 
   expect_null(measurement_update$end_date)
 })
+
+test_that("formatDateColumns displays timeline dates as ISO dates", {
+  timeline <- data.table::data.table(
+    type = c("condition_occurrence", "drug_exposure", "measurement"),
+    start_date = c(
+      as.Date("2020-01-10"),
+      as.Date("2020-02-10"),
+      as.Date(NA)
+    ),
+    end_date = c(
+      as.Date("2020-01-12"),
+      as.Date("2020-02-12"),
+      as.Date(NA)
+    )
+  )
+
+  formatted <- format_date_columns(timeline)
+
+  expect_equal(formatted$start_date, c("2020-01-10", "2020-02-10", NA_character_))
+  expect_equal(formatted$end_date, c("2020-01-12", "2020-02-12", NA_character_))
+  expect_s3_class(timeline$start_date, "Date")
+})
+
+test_that("formatDateColumns handles numeric and POSIX timeline dates", {
+  timeline <- data.frame(
+    start_date = as.numeric(as.Date("2020-03-10")),
+    end_date = as.POSIXct("2020-03-12 00:00:00", tz = "UTC")
+  )
+
+  formatted <- format_date_columns(timeline)
+
+  expect_equal(formatted$start_date, "2020-03-10")
+  expect_equal(formatted$end_date, "2020-03-12")
+})
+
+test_that("formatDateColumns displays native CDM date columns as ISO dates", {
+  drug_exposure <- data.frame(
+    drug_exposure_id = 1L,
+    drug_exposure_start_date = as.Date("2020-04-10"),
+    drug_exposure_end_date = as.Date("2020-04-20"),
+    verbatim_end_date = as.Date("2020-04-20")
+  )
+
+  formatted <- format_date_columns(drug_exposure)
+
+  expect_equal(formatted$drug_exposure_start_date, "2020-04-10")
+  expect_equal(formatted$drug_exposure_end_date, "2020-04-20")
+  expect_equal(formatted$verbatim_end_date, "2020-04-20")
+})