Skip to content

add observation tab #59

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
ginberg merged 5 commits into from
Jun 16, 2026
Merged

add observation tab #59

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
e882dd3
#49 fix updating measurement/procedure
ginberg Jun 5, 2026
b99be04
revert
ginberg Jun 5, 2026
35ddd17
fix test
ginberg Jun 5, 2026
0887be2
fix saving procedure dates
ginberg Jun 8, 2026
1e8a2eb
add observation
ginberg Jun 8, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion R/cdm54data.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -66,7 +66,8 @@ columnNames <- function(
"condition_occurrence",
"drug_exposure",
"measurement",
"procedure_occurrence"
"procedure_occurrence",
"observation"
)

if (!is.null(name)) {
Expand Down
18 changes: 15 additions & 3 deletions R/cdmConstructor.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,12 +8,14 @@ cdmConstructor <- R6::R6Class(
condition_occurrence = NULL,
measurement = NULL,
procedure_occurrence = NULL,
observation = NULL,
initialize = function(tables = c(
"observation_period",
"condition_occurrence",
"drug_exposure",
"measurement",
"procedure_occurrence"
"procedure_occurrence",
"observation"
)
) {
self$tables <- tables
Expand Down Expand Up @@ -170,7 +172,8 @@ cdmConstructor <- R6::R6Class(
"condition_occurrence",
"drug_exposure",
"measurement",
"procedure_occurrence")) {
"procedure_occurrence",
"observation")) {
classTable <- class(jsonData[[tableName]])
table_data <- jsonData[[tableName]] |> as.data.table()
if (classTable == "data.frame") {
Expand All @@ -192,6 +195,7 @@ cdmConstructor <- R6::R6Class(
self$condition_occurrence$reset()
self$measurement$reset()
self$procedure_occurrence$reset()
self$observation$reset()
},

# Delete person or event
Expand Down Expand Up @@ -246,7 +250,8 @@ cdmConstructor <- R6::R6Class(
drug_exposure = self$drug_exposure$data(),
condition_occurrence = self$condition_occurrence$data(),
measurement = self$measurement$data(),
procedure_occurrence = self$procedure_occurrence$data()
procedure_occurrence = self$procedure_occurrence$data(),
observation = self$observation$data()
)

cdm_data_json <- jsonlite::toJSON(
Expand Down Expand Up @@ -352,12 +357,19 @@ cdmConstructor <- R6::R6Class(
names() |>
tail(-2) |>
head(3)

if (private$.tableName == "observation_period") {
values <- list(
as.Date("2010-02-28"),
as.Date("2015-02-28"),
44191562L
)
} else if (private$.tableName %in% c("measurement", "observation")) {
# this table has no end date
column_names <- column_names |> head(2)
values <- list(
44191562L,
as.Date("2010-02-28"))
} else {
values <- list(
44191562L,
Expand Down
4 changes: 3 additions & 1 deletion R/cdmTableClass.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -95,6 +95,8 @@ cdmTable <- R6::R6Class(
)
if (name == "start" & private$.tableName == "measurement") {
table_name_id <- "measurement_date"
} else if (name == "start" & private$.tableName == "observation") {
table_name_id <- "observation_date"
} else if (name == "start" & private$.tableName == "procedure_occurrence") {
table_name_id <- "procedure_date"
} else {
Expand All @@ -111,4 +113,4 @@ cdmTable <- R6::R6Class(
return(table_name_id)
}
)
)
)
41 changes: 21 additions & 20 deletions R/cdmTableModules.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -78,28 +78,17 @@ cdmTableServer <- function(
session
) {
ns <- session$ns
if (id == "condition_occurrence") {
table_id <- "condition"
} else {
table_id <- id
}

table_event_id <- paste(
id,
"id",
sep = "_"
)
table_concept_id <- cdm[[id]]$tableNameConceptId()
table_start_date <- paste(
table_id,
"start_date",
sep = "_"
)
table_end_date <- paste(
table_id,
"end_date",
sep = "_"
)
table_start_date <- cdm[[id]]$tableNameDate("start")
table_end_date <- cdm[[id]]$tableNameDate("end")
if (length(table_end_date) == 0) {
table_end_date <- NULL
}
columnList <- columnNames(
name = id,
limit = NULL
Expand Down Expand Up @@ -297,19 +286,31 @@ cdmTableServer <- function(
elongation_click <- reactiveVal(NULL)
#
# # Elongation
tableDateInputs <- reactive({
values <- list(input[[table_start_date]])
if (!is.null(table_end_date)) {
values <- c(values, list(input[[table_end_date]]))
}
values
})

observeEvent(
list(input[[table_start_date]], input[[table_end_date]]),
tableDateInputs(),
{
print(syncing)
req(!syncing())
req(input[[table_event_id]])
req(input[[table_start_date]])
req(input[[table_end_date]])
end_date <- NULL
if (!is.null(table_end_date)) {
req(input[[table_end_date]])
end_date <- input[[table_end_date]]
}

cdm[[id]]$updateDates(
person_id = person_id_selected(),
event_id = input[[table_event_id]],
start_date = input[[table_start_date]],
end_date = input[[table_end_date]]
end_date = end_date
)
elongation_click(Sys.time())
},
Expand Down
52 changes: 48 additions & 4 deletions R/patientsDesigner.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -118,6 +118,11 @@ patientDesigner <- function(path = NULL) {
"Procedure Occurrence",
cdmTableUI(id = "procedure_occurrence"),
value = "procedure_occurrence_module"
),
tabPanel(
"Observation",
cdmTableUI(id = "observation"),
value = "observation_module"
)
),
tabsetPanel(
Expand All @@ -138,7 +143,8 @@ patientDesigner <- function(path = NULL) {
tableOutput("drugExposureTable"),
tableOutput("conditionOccurrenceTable"),
tableOutput("measurementTable"),
tableOutput("procedureOccurrenceTable")
tableOutput("procedureOccurrenceTable"),
tableOutput("observationTable")
)
),
border = FALSE
Expand Down Expand Up @@ -311,8 +317,8 @@ patientDesigner <- function(path = NULL) {
cdm$person$data()
})

# After person selection
# Filters and updates observation/drug exposure fields
# After person selection, refresh event selectors for all
# patient-level event tables.
observeEvent(person_module(), {
req(person_module())

Expand All @@ -328,6 +334,24 @@ patientDesigner <- function(path = NULL) {
input_person_id = person_module,
session = session
)
updateTableIdsNs(
cdm = cdm,
type = "measurement",
input_person_id = person_module,
session = session
)
updateTableIdsNs(
cdm = cdm,
type = "procedure_occurrence",
input_person_id = person_module,
session = session
)
updateTableIdsNs(
cdm = cdm,
type = "observation",
input_person_id = person_module,
session = session
)
updateTableIdsNs(
cdm = cdm,
type = "drug_exposure",
Expand Down Expand Up @@ -426,6 +450,22 @@ patientDesigner <- function(path = NULL) {
cdm$procedure_occurrence$data()
})

# OBSERVATION TABLE
observation_module <- cdmTableServer(
id = "observation",
cdm = cdm,
person_id_selected = person_module,
syncing = syncing
)

output$observationTable <- renderTable({
data_version()
observation_module$add_click()
observation_module$delete_click()
observation_module$elongation_click()
cdm$observation$data()
})

# CDM Data Timeline
cdmDataTimeline <- reactive({
pid <- suppressWarnings(as.numeric(person_module()))
Expand All @@ -451,6 +491,9 @@ patientDesigner <- function(path = NULL) {
procedure_occurrence_module$add_click(),
procedure_occurrence_module$delete_click(),
procedure_occurrence_module$elongation_click(),
observation_module$add_click(),
observation_module$delete_click(),
observation_module$elongation_click(),
ignoreInit = FALSE
)

Expand Down Expand Up @@ -494,7 +537,8 @@ patientDesigner <- function(path = NULL) {
person_id <- update_data$person_id
event_id <- update_data$event_id
type <- update_data$type
end_date <- if (identical(type, "measurement")) NULL else update_data$end_date
has_end_date <- length(cdm[[type]]$tableNameDate("end")) > 0
end_date <- if (isTRUE(has_end_date)) update_data$end_date else NULL
print("END DATA:")
update_data$start_date %>% print()
end_date %>% print()
Expand Down
18 changes: 3 additions & 15 deletions R/updateFunctions.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -163,22 +163,10 @@ updateTableDatesNs <- function(cdm,
input,
syncing) {

# browser()
if (type == "condition_occurrence") {
type_corrected <- "condition"
} else if (type == "measurement") {
type_corrected <- "measurement"
} else {
type_corrected <- type
}

# Access names
if (type == "measurement") {
table_start_date <- "measurement_date"
table_start_date <- cdm[[type]]$tableNameDate("start")
table_end_date <- cdm[[type]]$tableNameDate("end")
if (length(table_end_date) == 0) {
table_end_date <- NULL
} else {
table_start_date <- glue::glue("{type_corrected}_start_date")
table_end_date <- glue::glue("{type_corrected}_end_date")
}
table_id <- glue::glue("{type}_id")

Expand Down
27 changes: 21 additions & 6 deletions inst/d3/cdm_timeline.js
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,11 @@ const gap = 12
const axisPad = 12
const labelPad = 8
const measurementMarkerWidth = barHeight
const pointEventTypes = new Set(["measurement", "observation"])

function isPointEvent(d) {
return pointEventTypes.has(d.type);
}

function formatDate(value) {
if (value === null || value === undefined || value === "") {
Expand Down Expand Up @@ -47,7 +52,7 @@ function tooltipText(d) {
}

function labelX(scale, d) {
if (d.type === "measurement") {
if (isPointEvent(d)) {
return scale(new Date(d.start_date)) - measurementMarkerWidth - labelPad;
}

Expand Down Expand Up @@ -79,6 +84,8 @@ function startColor(d, i) {
return "#D81B60";
} else if (d.type == "measurement") {
return "#E53935";
} else if (d.type == "observation") {
return "#8E44AD";
} else if (d.type == "procedure_occurrence") {
return "#1E88E5";
}
Expand All @@ -94,6 +101,8 @@ function dragColor(type) {
return "#F06292";
} else if (type == "measurement") {
return "#FF6F60";
} else if (type == "observation") {
return "#B47CD9";
} else if (type == "procedure_occurrence") {
return "#64B5F6";
}
Expand All @@ -109,6 +118,8 @@ function endColor(type) {
return "#D81B60";
} else if (type == "measurement") {
return "#E53935";
} else if (type == "observation") {
return "#8E44AD";
} else if (type == "procedure_occurrence") {
return "#1E88E5";
}
Expand Down Expand Up @@ -357,7 +368,11 @@ r2d3.onRender(function(data, svg, width, height, options) {

const value_start_date = d3.timeFormat("%Y-%m-%d")(new Date(d.start_date));

d3.select("#measurement-measurement_date input")
const name_start_date = d.type === "observation"
? "#observation-observation_date input"
: "#measurement-measurement_date input";

d3.select(name_start_date)
.property("value", value_start_date)
.dispatch("change");

Expand Down Expand Up @@ -579,7 +594,7 @@ r2d3.onRender(function(data, svg, width, height, options) {
let g = svg.append("g")

g.selectAll("rect.rectGroup")
.data(data.filter(d => d.type !== "measurement"))
.data(data.filter(d => !isPointEvent(d)))
.enter()
.append("rect")
.attr("class", d => `rectGroup row_${d.categories}`)
Expand All @@ -596,7 +611,7 @@ r2d3.onRender(function(data, svg, width, height, options) {
.attr("transform", `translate(${margin.left},${margin.top + axisPad})`)

g.selectAll("polygon.measurementMarker")
.data(data.filter(d => d.type === "measurement"))
.data(data.filter(d => isPointEvent(d)))
.enter()
.append("polygon")
.attr("class", d => `measurementMarker row_${d.categories}`)
Expand Down Expand Up @@ -630,7 +645,7 @@ r2d3.onRender(function(data, svg, width, height, options) {
.attr("transform", `translate(${margin.left},${margin.top + axisPad})`)

g.selectAll("circle.circleRightGroup")
.data(data.filter(d => d.type !== "measurement"))
.data(data.filter(d => !isPointEvent(d)))
.enter()
.append("circle")
.attr("class", d => `circleRightGroup row_${d.categories}`)
Expand All @@ -643,7 +658,7 @@ r2d3.onRender(function(data, svg, width, height, options) {
.attr("transform", `translate(${margin.left},${margin.top + axisPad})`)

g.selectAll("circle.circleLeftGroup")
.data(data.filter(d => d.type !== "measurement"))
.data(data.filter(d => !isPointEvent(d)))
.enter()
.append("circle")
.attr("class", d => `circleLeftGroup row_${d.categories}`)
Expand Down
Loading
Loading