diff --git a/R/patientsDesigner.R b/R/patientsDesigner.R index 1e89e21..fd8cd63 100644 --- a/R/patientsDesigner.R +++ b/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 diff --git a/R/timelineHelpers.R b/R/timelineHelpers.R index d1a52a6..abd7356 100644 --- a/R/timelineHelpers.R +++ b/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) +} diff --git a/tests/testthat/helper-internals.R b/tests/testthat/helper-internals.R index 17b7b8c..8d47cfc 100644 --- a/tests/testthat/helper-internals.R +++ b/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") diff --git a/tests/testthat/test-timelineHelpers.R b/tests/testthat/test-timelineHelpers.R index 2f7e256..24e93fa 100644 --- a/tests/testthat/test-timelineHelpers.R +++ b/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") +})