mock visit occurrence

NAMESPACE

@@ -21,6 +21,7 @@ export(mockObservation)
 export(mockObservationPeriod)
 export(mockPerson)
 export(mockProcedureOccurrence)
+export(mockVisitOccurrence)
 export(mockVocabularyTables)
 export(settings)
 importFrom(omopgenerics,attrition)

R/checkInputs.R

@@ -246,3 +246,14 @@ correctCdmFormat <- function(table, tableName) {
 
 
 }
+#' get column start date
+#'
+#' @noRd
+#'
+startDateColumn <- function(tableName) {
+  if (tableName %in% namesTable$table_name) {
+    return(namesTable$start_date_name[namesTable$table_name == tableName])
+  } else {
+    return("cohort_start_date")
+  }
+}

R/mockVisitOccurrence.R

@@ -1,101 +1,98 @@
 #' Function to generate visit occurrence table
 #'
 #' @param cdm the CDM reference into which the  mock visit occurrence table will be added
-#' @param recordPerson The expected number of records per person within each cohort. This can help simulate the frequency of observations for individuals in the cohort.
 #' @param seed A random seed to ensure reproducibility of the generated data.
 #'
-#' @return A cdm reference with the mock tables
-#' @noRd
+#' @return A cdm reference with the visit_occurrence tables added
+#' @export
 #'
 #' @examples
 #' library(omock)
 #'
-#' cdm <- mockCdmReference() |>
-#'   mockPerson() |>
-#'   mockObservationPeriod() |>
-#'   mockVisitOccurrence()
-#'
-#' cdm$visit_occurrence
-#'
 mockVisitOccurrence <- function(cdm,
-                                recordPerson = 1,
-                                seed = 1) {
+                                seed = NULL) {
   checkInput(
     cdm = cdm,
-    recordPerson = recordPerson,
     seed = seed
   )
 
   if (!is.null(seed)) {
     set.seed(seed = seed)
   }
 
-  # check if table are empty
-  if (cdm$person |> nrow() == 0 &&
-      cdm$observation_period |> nrow() == 0 && is.null(cdm$concept) &&
-      cdm$condition_occurrence |> nrow() == 0) {
-    cli::cli_abort("person, observation_period and
-                   condition_occurrence table cannot be empty")
-  }
 
+  # check for table with persion_id or vist_occurrence_id
+  tableName <- c()
+  for (tab in names(cdm)) {
+    if (all(c("person_id", "visit_occurrence_id") %in% colnames(cdm[[tab]]))) {
+      tableName <-
+        c(tableName, tab)
+    }
+  }
 
+  if (length(tableName) == 0) {
+    cli::cli_warn("Your cdm object don't contain clinical tables with visit_occurrence_id.")
 
-  concept_id <-
-    cdm$concept |>
-    dplyr::filter(.data$domain_id == "Visit") |>
-    dplyr::select("concept_id") |>
-    dplyr::pull() |>
-    unique()
+    return(cdm)
+  }
 
-  # concept count
-  concept_count <- length(concept_id)
+  visit <- dplyr::tibble()
+#create visit occurrence table
+  for (tab in tableName) {
+    startDate <- startDateColumn(tab)
 
-  # number of rows per concept_id
-  numberRows <-
-    recordPerson * (cdm$person |> dplyr::tally() |> dplyr::pull()) |> round()
+    table <-  cdm[[tab]] |>
+      dplyr::select(
+        "person_id",
+        "visit_start_date" = dplyr::all_of(startDate),
+        "visit_end_date" = dplyr::all_of(startDate)
+      )
 
-  visit <- list()
+    visit <- visit |>
+      rbind(table) |>
+      dplyr::distinct()
 
-  for (i in seq_along(concept_id)) {
-    num <- numberRows
-    visit[[i]] <- dplyr::tibble(
-      visit_concept_id = concept_id[i],
-      subject_id = sample(
-        x = cdm$person |> dplyr::pull("person_id"),
-        size = num,
-        replace = TRUE
-      )
-    ) |>
-      addCohortDates(
-        start = "visit_start_date",
-        end = "visit_end_date",
-        observationPeriod = cdm$observation_period
-      )
   }
 
-  # vist_type_id <- cdm$concept |>
-  #   dplyr::filter(.data$vocabulary_id == "Visit") |>
-  #   dplyr::select(concept_id) |>
-  #   dplyr::pull()
-  #
-  # visit_id <- sample(vist_type_id,)
+  vist_type_id <- cdm$concept |>
+    dplyr::filter(.data$vocabulary_id == "Visit") |>
+    dplyr::select(.data$concept_id) |>
+    dplyr::pull()
 
-
-  visit <-
-    visit |>
-    dplyr::bind_rows() |>
+  visit <- visit |>
     dplyr::mutate(
-      visit_occurrence_id = dplyr::row_number(),
-      visit_type_concept_id = 1
-    ) |>
-    dplyr::rename(person_id = "subject_id")
+    visit_occurrence_id = dplyr::row_number(),
+    "visit_concept_id" := !!sample(vist_type_id, nrow(visit), replace = TRUE),
+    visit_type_concept_id = .data$visit_concept_id
+  )|>
+    addOtherColumns(tableName = "visit_occurrence") |>
+    correctCdmFormat(tableName = "visit_occurrence")
 
   cdm <-
     omopgenerics::insertTable(
       cdm = cdm,
       name = "visit_occurrence",
       table = visit
     )
+#add visit_occurrence detail to clinical table
+  for (tab in tableName) {
+    startDate <- startDateColumn(tab)
+
+    cdm[[tab]] <-  cdm[[tab]] |>
+      dplyr::select(!"visit_occurrence_id") |>
+      dplyr::inner_join(
+        cdm$visit_occurrence |>
+          dplyr::select(
+            "person_id",
+            !!startDate := "visit_start_date",
+            "visit_occurrence_id"
+          ),
+        by = c("person_id", startDate)
+      )
+
+  }
 
   return(cdm)
 }
+
+

_pkgdown.yml

@@ -11,7 +11,7 @@ reference:
   - title: "Mock Table Creation"
     desc: "These functions are focused on adding mock data tables based on the initialized CDM structure."
     contents:
-      - matches("mockPerson|mockObservationPeriod|mockConditionOccurrence|mockDeath|mockDrugExposure|mockMeasurement|mockObservation|mockProcedureOccurrence")
+      - matches("mockPerson|mockObservationPeriod|mockConditionOccurrence|mockDeath|mockDrugExposure|mockMeasurement|mockObservation|mockProcedureOccurrence|mockVisitOccurrence")
 
   - title: "Vocabulary Tables Creation"
     desc: "This group includes functions that set up vocabulary tables."

tests/testthat/test-mockDrugExposure.R

@@ -30,4 +30,19 @@ test_that("test mock drug exposure", {
 
   expect_true(cdm$drug_exposure |> dplyr::tally() |> dplyr::pull() == concept_count *
     10 * 2)
+
+  #add visit details
+
+  cdm <- cdm |> mockVisitOccurrence()
+
+  expect_no_error(cdm |> mockVisitOccurrence())
+
+  expect_true(!is.null(cdm$drug_exposure |>
+                         dplyr::pull(visit_occurrence_id)))
+
+  expect_warning(omock::mockCdmReference() |> mockVisitOccurrence())
+
+
 })
+
+