From 09e19e3411934fd7c0f59fda896025ca2cf13208 Mon Sep 17 00:00:00 2001 From: Ger Inberg Date: Wed, 10 Jun 2026 07:49:41 +0200 Subject: [PATCH 1/2] format dates in test data tab --- R/patientsDesigner.R | 5 ++-- R/timelineHelpers.R | 35 +++++++++++++++++++++++++++ tests/testthat/helper-internals.R | 1 + tests/testthat/test-timelineHelpers.R | 34 ++++++++++++++++++++++++++ 4 files changed, 72 insertions(+), 3 deletions(-) diff --git a/R/patientsDesigner.R b/R/patientsDesigner.R index 76a31d2..63b68ca 100644 --- a/R/patientsDesigner.R +++ b/R/patientsDesigner.R @@ -132,7 +132,6 @@ patientDesigner <- function(path = NULL) { tabPanel( "Test Data", tableOutput("cdmData"), - # verbatimTextOutput("cdmData"), tableOutput("personDataTable"), tableOutput("observationPeriodTable"), tableOutput("drugExposureTable"), @@ -430,7 +429,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( @@ -457,7 +456,7 @@ patientDesigner <- function(path = NULL) { # Render cdm table output$cdmData <- renderTable({ req(cdmDataTimeline) - cdmDataTimeline() + formatTimelineDateColumns(cdmDataTimeline()) }) ## UPDATE DATA FROM D3 diff --git a/R/timelineHelpers.R b/R/timelineHelpers.R index d1a52a6..461908c 100644 --- a/R/timelineHelpers.R +++ b/R/timelineHelpers.R @@ -22,3 +22,38 @@ normalizeBarEndUpdate <- function(update_data) { update_data } + +formatTimelineDateColumns <- function(data) { + date_cols <- intersect(c("start_date", "end_date"), names(data)) + if (length(date_cols) == 0) { + return(data) + } + + data <- as.data.frame(data) + for (date_col in date_cols) { + data[[date_col]] <- formatTimelineDateColumn(data[[date_col]]) + } + + data +} + +formatTimelineDateColumn <- 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) +} diff --git a/tests/testthat/helper-internals.R b/tests/testthat/helper-internals.R index 2df0e97..663b5fc 100644 --- a/tests/testthat/helper-internals.R +++ b/tests/testthat/helper-internals.R @@ -8,3 +8,4 @@ new_cdm_table <- function(type) { cdm_table_server <- getFromNamespace("cdmTableServer", "PatientGenerator") normalize_bar_end_update <- getFromNamespace("normalizeBarEndUpdate", "PatientGenerator") +format_timeline_date_columns <- getFromNamespace("formatTimelineDateColumns", "PatientGenerator") diff --git a/tests/testthat/test-timelineHelpers.R b/tests/testthat/test-timelineHelpers.R index 2f7e256..b955e00 100644 --- a/tests/testthat/test-timelineHelpers.R +++ b/tests/testthat/test-timelineHelpers.R @@ -30,3 +30,37 @@ test_that("normalizeBarEndUpdate leaves measurement end date untouched", { expect_null(measurement_update$end_date) }) + +test_that("formatTimelineDateColumns 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_timeline_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("formatTimelineDateColumns 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_timeline_date_columns(timeline) + + expect_equal(formatted$start_date, "2020-03-10") + expect_equal(formatted$end_date, "2020-03-12") +}) From 923f63a2cdca02d008e7edecaa9257e2bd7bb305 Mon Sep 17 00:00:00 2001 From: Ger Inberg Date: Wed, 10 Jun 2026 08:02:04 +0200 Subject: [PATCH 2/2] other tables as well --- R/patientsDesigner.R | 12 ++++++------ R/timelineHelpers.R | 11 +++++++---- tests/testthat/helper-internals.R | 2 +- tests/testthat/test-timelineHelpers.R | 23 +++++++++++++++++++---- 4 files changed, 33 insertions(+), 15 deletions(-) diff --git a/R/patientsDesigner.R b/R/patientsDesigner.R index 63b68ca..a39456f 100644 --- a/R/patientsDesigner.R +++ b/R/patientsDesigner.R @@ -354,7 +354,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 @@ -373,7 +373,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 @@ -390,7 +390,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 @@ -406,7 +406,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 @@ -422,7 +422,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()) }) # CDM Data Timeline @@ -456,7 +456,7 @@ patientDesigner <- function(path = NULL) { # Render cdm table output$cdmData <- renderTable({ req(cdmDataTimeline) - formatTimelineDateColumns(cdmDataTimeline()) + formatDateColumns(cdmDataTimeline()) }) ## UPDATE DATA FROM D3 diff --git a/R/timelineHelpers.R b/R/timelineHelpers.R index 461908c..abd7356 100644 --- a/R/timelineHelpers.R +++ b/R/timelineHelpers.R @@ -23,21 +23,24 @@ normalizeBarEndUpdate <- function(update_data) { update_data } -formatTimelineDateColumns <- function(data) { - date_cols <- intersect(c("start_date", "end_date"), names(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]] <- formatTimelineDateColumn(data[[date_col]]) + data[[date_col]] <- formatDateColumn(data[[date_col]]) } data } -formatTimelineDateColumn <- function(x) { +formatDateColumn <- function(x) { if (inherits(x, "Date")) { return(as.character(x)) } diff --git a/tests/testthat/helper-internals.R b/tests/testthat/helper-internals.R index 663b5fc..eb856a3 100644 --- a/tests/testthat/helper-internals.R +++ b/tests/testthat/helper-internals.R @@ -8,4 +8,4 @@ new_cdm_table <- function(type) { cdm_table_server <- getFromNamespace("cdmTableServer", "PatientGenerator") normalize_bar_end_update <- getFromNamespace("normalizeBarEndUpdate", "PatientGenerator") -format_timeline_date_columns <- getFromNamespace("formatTimelineDateColumns", "PatientGenerator") +format_date_columns <- getFromNamespace("formatDateColumns", "PatientGenerator") diff --git a/tests/testthat/test-timelineHelpers.R b/tests/testthat/test-timelineHelpers.R index b955e00..24e93fa 100644 --- a/tests/testthat/test-timelineHelpers.R +++ b/tests/testthat/test-timelineHelpers.R @@ -31,7 +31,7 @@ test_that("normalizeBarEndUpdate leaves measurement end date untouched", { expect_null(measurement_update$end_date) }) -test_that("formatTimelineDateColumns displays timeline dates as ISO dates", { +test_that("formatDateColumns displays timeline dates as ISO dates", { timeline <- data.table::data.table( type = c("condition_occurrence", "drug_exposure", "measurement"), start_date = c( @@ -46,21 +46,36 @@ test_that("formatTimelineDateColumns displays timeline dates as ISO dates", { ) ) - formatted <- format_timeline_date_columns(timeline) + 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("formatTimelineDateColumns handles numeric and POSIX timeline dates", { +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_timeline_date_columns(timeline) + 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") +})