Fix exposures_outcome_set_id field in 'sccs_exposure' and 'sccs_exp…

…osures_outcome_set' tables.
OHDSI · Jun 6, 2024 · ef4188b · ef4188b
1 parent 32429b7
commit ef4188b
Show file tree

Hide file tree

Showing 4 changed files with 31 additions and 6 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: SelfControlledCaseSeries
 Type: Package
 Title: Self-Controlled Case Series
-Version: 5.2.0
-Date: 2024-05-31
+Version: 5.2.1
+Date: 2024-06-06
 Authors@R: c(
   person("Martijn", "Schuemie", , "[email protected]", role = c("aut", "cre")),
 	person("Patrick", "Ryan", role = c("aut")),

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,12 @@
+SelfControlledCaseSeries 5.2.1
+==============================
+
+Bugfixes
+
+1. Fix `exposures_outcome_set_id` field in 'sccs_exposure' and 'sccs_exposures_outcome_set' tables.
+
+
+
 SelfControlledCaseSeries 5.2.0
 ==============================
 

diff --git a/R/Export.R b/R/Export.R
@@ -237,6 +237,8 @@ exportExposuresOutcomes <- function(outputFolder, exportFolder) {
   message("- sccs_exposure and sccs_exposures_outcome_set tables")
 
   esoList <- readRDS(file.path(outputFolder, "exposuresOutcomeList.rds"))
+  ref <- getFileReference(outputFolder) %>%
+    distinct(exposuresOutcomeSetId, exposuresOutcomeSetSeqId)
 
   # exposure = eso$exposures[[1]]
   convertExposureToTable <- function(exposure) {
@@ -255,25 +257,29 @@ exportExposuresOutcomes <- function(outputFolder, exportFolder) {
     exposures <- lapply(eso$exposures, convertExposureToTable) %>%
       bind_rows() %>%
       mutate(
-        exposuresOutcomeSetId = i
+        exposuresOutcomeSetSeqId = i
       )
     sccsExposure[[length(sccsExposure) + 1]] <- exposures
 
     exposuresOutcomeSet <- tibble(
-      exposuresOutcomeSetId = i,
+      exposuresOutcomeSetSeqId = i,
       nestingCohortId = eso$nestingCohortId,
       outcomeId = eso$outcomeId
     )
     sccsExposuresOutcomeSet[[length(sccsExposuresOutcomeSet) + 1]] <- exposuresOutcomeSet
   }
 
   sccsExposure <- sccsExposure %>%
-    bind_rows()
+    bind_rows() %>%
+    inner_join(ref, by = join_by("exposuresOutcomeSetSeqId")) %>%
+    select(-"exposuresOutcomeSetSeqId")
   fileName <- file.path(exportFolder, "sccs_exposure.csv")
   writeToCsv(sccsExposure, fileName)
 
   sccsExposuresOutcomeSet <- sccsExposuresOutcomeSet %>%
-    bind_rows()
+    bind_rows() %>%
+    inner_join(ref, by = join_by("exposuresOutcomeSetSeqId")) %>%
+    select(-"exposuresOutcomeSetSeqId")
   fileName <- file.path(exportFolder, "sccs_exposures_outcome_set.csv")
   writeToCsv(sccsExposuresOutcomeSet, fileName)
 }

diff --git a/tests/testthat/test-eunomia.R b/tests/testthat/test-eunomia.R
@@ -181,6 +181,16 @@ test_that("Running multiple analyses against Eunomia", {
   diagnosticsSummary <- readr::read_csv(file.path(outputFolder, "export", "sccs_diagnostics_summary.csv"), show_col_types = FALSE)
   expect_true(all(diagnosticsSummary$ease_diagnostic == "NOT EVALUATED"))
 
+  # Make sure exposures_outcome_set_id is consistent across table:
+  exposure <- readr::read_csv(file.path(outputFolder, "export", "sccs_exposure.csv"), show_col_types = FALSE)
+  eos <- readr::read_csv(file.path(outputFolder, "export", "sccs_exposures_outcome_set.csv"), show_col_types = FALSE)
+  expect_length(setdiff(unique(diagnosticsSummary$exposures_outcome_set_id),
+                        unique(exposure$exposures_outcome_set_id)),
+                0)
+  expect_length(setdiff(unique(eos$exposures_outcome_set_id),
+                        unique(exposure$exposures_outcome_set_id)),
+                0)
+
   specs <- readr::read_csv(
     file = system.file("csv", "resultsDataModelSpecification.csv", package = "SelfControlledCaseSeries"),
     show_col_types = FALSE