Add stratiffication for hospital

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ROMOPAPI
 Title: ROMOPAPI
-Version: 2.2.0
+Version: 2.3.0
 Authors@R: 
     person("Javier", "Gracia-Tabuenca", , "javier.graciatabuenca@tuni.fi", role = c("aut", "cre"),
            comment = c(ORCID = "YOUR-ORCID-ID"))

Dockerfile

@@ -24,12 +24,15 @@ RUN apt-get update && apt-get install -y openjdk-8-jdk liblzma-dev libbz2-dev li
 ARG ROMOPAPI_BRANCH=main
 ARG BUILD_CACHE_BUSTER=5
 
+COPY . /opt/ROMOPAPI
+
 # Install renv and restore packages
 RUN --mount=type=secret,id=build_github_pat \
     cp /usr/local/lib/R/etc/Renviron /tmp/Renviron \
     && echo "GITHUB_PAT=$(cat /run/secrets/build_github_pat)" >> /usr/local/lib/R/etc/Renviron \
     && Rscript -e 'install.packages("remotes")' \
-    && Rscript -e 'remotes::install_github("FINNGEN/ROMOPAPI@'$ROMOPAPI_BRANCH'")' \
+    && Rscript -e "remotes::install_local('/opt/ROMOPAPI', upgrade = 'never', dependencies = TRUE)" \
+    && Rscript -e "if (!requireNamespace('ROMOPAPI', quietly = TRUE)) stop('ROMOPAPI installation failed')" \
     && cp /tmp/Renviron /usr/local/lib/R/etc/Renviron;
 
 # Expose the port that the API will run on

NAMESPACE

@@ -19,6 +19,8 @@ export(getCodeCounts_memoise)
 export(getConceptsWithCodeCounts)
 export(getConceptsWithCodeCounts_memoise)
 export(getLogs)
+export(getVisitTypeNames)
+export(getVisitTypeNames_memoise)
 export(helper_FinnGen_getDatabaseFile)
 export(helper_FinnGen_getDatabaseFileCounts)
 export(helper_createSqliteDatabaseFromDatabase)

NEWS.md

@@ -1,4 +1,8 @@
-# ROMOPAPI 
+# ROMOPAPI 2.3.0
+- /getCodeCounts now retuns one more column `visit_group_concept_id` in `stratified_code_counts` table, this is the register they come from 
+- New endpoint /getVisitTypeNames returns a table with the names and codes for `visit_group_concept_id`s
+
+# ROMOPAPI 2.2.0
 - Added number_of_descendants to concepts with code counts
 - Added conceptId 21600744 to testing data
 

R/createCodeCountsTables.R

@@ -8,6 +8,7 @@
 #' @param CDMdbHandler A CDMdbHandler object that contains database connection details
 #' @param domains Optional vector of domains to process. If NULL, processes all standard domains
 #' @param codeCountsTable Name of the table to create. Defaults to "code_counts"
+#' @param visitSourceGroupConceptIds Optional vector of visit source group concept IDs to filter by. Defaults to 0
 #'
 #' @return Nothing. Creates a table called 'code_counts' in the results schema with columns:
 #' \itemize{
@@ -35,14 +36,16 @@
 #' \dontrun{
 #' # Create code counts table for all domains
 #' createCodeCountsTable(CDMdbHandler)
-#' 
+#'
 #' # Create code counts table for specific domains only
 #' createCodeCountsTable(CDMdbHandler, domains = c("Condition", "Drug"))
 #' }
 createCodeCountsTables <- function(
     CDMdbHandler,
-    domains = NULL, 
-    codeCountsTable = "code_counts") {
+    domains = NULL,
+    codeCountsTable = "code_counts",
+    visitSourceGroupConceptIds = 0
+) {
     #
     # VALIDATE
     #
@@ -58,13 +61,23 @@ createCodeCountsTables <- function(
 
     # - Create stratified code counts table
     stratifiedCodeCountsTable <- paste0("stratified_", codeCountsTable)
-    createStratifiedCodeCountsTable(CDMdbHandler, domains = domains, stratifiedCodeCountsTable = stratifiedCodeCountsTable)
-
+    createStratifiedCodeCountsTable(
+        CDMdbHandler,
+        domains = domains,
+        stratifiedCodeCountsTable = stratifiedCodeCountsTable,
+        visitSourceGroupConceptIds = visitSourceGroupConceptIds
+    )
 
     # - Create code counts table
-    sqlPath <- system.file("sql", "sql_server", "createCodeCountsTable.sql", package = "ROMOPAPI")
+    sqlPath <- system.file(
+        "sql",
+        "sql_server",
+        "createCodeCountsTable.sql",
+        package = "ROMOPAPI"
+    )
     sql <- SqlRender::readSql(sqlPath)
-    sql <- SqlRender::render(sql,
+    sql <- SqlRender::render(
+        sql,
         cdmDatabaseSchema = cdmDatabaseSchema,
         resultsDatabaseSchema = resultsDatabaseSchema,
         codeCountsTable = codeCountsTable,

R/createStratifiedCodeCountsTable.R

@@ -8,6 +8,7 @@
 #' @param CDMdbHandler A CDMdbHandler object that contains database connection details
 #' @param domains Optional data frame defining domains to process. If NULL, uses standard OMOP domains
 #' @param stratifiedCodeCountsTable Name of the stratified counts table to create. Defaults to "stratified_code_counts"
+#' @param visitSourceGroupConceptIds Optional vector of visit source group concept IDs to filter by. Defaults to 0
 #'
 #' @return Nothing. Creates a table called 'stratified_code_counts' in the results schema with columns:
 #' \itemize{
@@ -41,7 +42,9 @@
 createStratifiedCodeCountsTable <- function(
     CDMdbHandler,
     domains = NULL, 
-    stratifiedCodeCountsTable = "stratified_code_counts") {
+    stratifiedCodeCountsTable = "stratified_code_counts", 
+    visitSourceGroupConceptIds = 0
+    ) {
     #
     # VALIDATE
     #
@@ -51,6 +54,7 @@ createStratifiedCodeCountsTable <- function(
     cdmDatabaseSchema <- CDMdbHandler$cdmDatabaseSchema
     resultsDatabaseSchema <- CDMdbHandler$resultsDatabaseSchema
 
+
     if (is.null(domains)) {
         domains <- tibble::tribble(
             ~domain_id, ~table_name, ~concept_id_field, ~date_field, ~maps_to_concept_id_field,
@@ -80,6 +84,7 @@ createStratifiedCodeCountsTable <- function(
     CREATE TABLE @resultsDatabaseSchema.@stratifiedCodeCountsTable (
         concept_id INTEGER,
         maps_to_concept_id INTEGER,
+        visit_group_concept_id INTEGER,
         calendar_year INTEGER,
         gender_concept_id INTEGER,
         age_decile INTEGER,
@@ -102,7 +107,8 @@ createStratifiedCodeCountsTable <- function(
             table_name = domain$table_name,
             concept_id_field = domain$concept_id_field,
             date_field = domain$date_field,
-            maps_to_concept_id_field = domain$maps_to_concept_id_field
+            maps_to_concept_id_field = domain$maps_to_concept_id_field, 
+            visit_group_concept_ids = paste0(visitSourceGroupConceptIds, collapse = ", ")
         )
 
         sql <- SqlRender::translate(sql, targetDialect = connection@dbms)

R/getCodeCounts.R

@@ -193,10 +193,10 @@ getCodeCounts <- function(
         codeCounts |> 
             dplyr::select(-concept_id) |> 
             dplyr::rename(concept_id = maps_to_concept_id) |> 
-            dplyr::distinct(concept_id, calendar_year, gender_concept_id, age_decile, record_counts),
+            dplyr::distinct(concept_id, visit_group_concept_id, calendar_year, gender_concept_id, age_decile, record_counts),
         # standard concepts, agregate counts
         codeCounts |> dplyr::select(-maps_to_concept_id) |> 
-            dplyr::group_by(concept_id, calendar_year, gender_concept_id, age_decile) |>
+            dplyr::group_by(concept_id, visit_group_concept_id, calendar_year, gender_concept_id, age_decile) |>
             dplyr::summarise(record_counts = sum(record_counts), .groups = "drop")
     )  |> 
     # If concept maps to itself, bcs concept in concept and source concept columns, dont take it
@@ -221,14 +221,14 @@ getCodeCounts <- function(
 
     nodeDescendantRecordCounts <- ancestorTableOfDescendant |>
         dplyr::inner_join(codeCountsPerId, by = c("descendant_concept_id" = "concept_id")) |>
-        dplyr::group_by(concept_id, calendar_year, gender_concept_id, age_decile) |>
+        dplyr::group_by(concept_id, visit_group_concept_id, calendar_year, gender_concept_id, age_decile) |>
         dplyr::summarise(
             descendant_record_counts = sum(record_counts),
             .groups = "drop"
         )
 
     stratifiedCodeCounts <- codeCountsPerId |>
-        dplyr::full_join(nodeDescendantRecordCounts, by = c("concept_id", "calendar_year", "gender_concept_id", "age_decile")) |> 
+        dplyr::full_join(nodeDescendantRecordCounts, by = c("concept_id", "visit_group_concept_id", "calendar_year", "gender_concept_id", "age_decile")) |> 
         dplyr::mutate(
             descendant_record_counts = dplyr::if_else(is.na(descendant_record_counts), record_counts, descendant_record_counts),
             record_counts = dplyr::if_else(is.na(record_counts), 0, record_counts)

R/getVisitTypeNames.R

@@ -0,0 +1,91 @@
+#' Get visit type names
+#'
+#' @description
+#' Retrieves a list of visit group concept IDs used in the stratified code counts table
+#' along with their associated concept names and codes.
+#'
+#' @param CDMdbHandler A CDMdbHandler object that contains database connection details
+#' @param stratifiedCodeCountsTable Name of the stratified code counts table. Defaults to "stratified_code_counts"
+#'
+#' @return A tibble with columns:
+#' \itemize{
+#'   \item `visitGroupConceptId` - The visit group concept ID
+#'   \item `conceptCode` - The OMOP concept code
+#'   \item `conceptName` - The human-readable concept name
+#' }
+#'
+#' @importFrom checkmate assertClass
+#' @importFrom DatabaseConnector renderTranslateQuerySql
+#' @importFrom tibble as_tibble
+#'
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' # Get visit type names
+#' result <- getVisitTypeNames(CDMdbHandler)
+#' }
+getVisitTypeNames <- function(
+    CDMdbHandler,
+    stratifiedCodeCountsTable = "stratified_code_counts") {
+    #
+    # VALIDATE
+    #
+    CDMdbHandler |> checkmate::assertClass("CDMdbHandler")
+
+    connection <- CDMdbHandler$connectionHandler$getConnection()
+    vocabularyDatabaseSchema <- CDMdbHandler$vocabularyDatabaseSchema
+    resultsDatabaseSchema <- CDMdbHandler$resultsDatabaseSchema
+
+    ParallelLogger::logInfo("getVisitTypeNames: Getting visit type names")
+
+    #
+    # FUNCTION
+    #
+    sql <- "
+    SELECT DISTINCT 
+        scc.visit_group_concept_id AS visitGroupConceptId,
+        c.concept_code AS conceptCode,
+        c.concept_name AS conceptName
+    FROM @resultsDatabaseSchema.@stratifiedCodeCountsTable scc
+    INNER JOIN @vocabularyDatabaseSchema.concept c
+        ON scc.visit_group_concept_id = c.concept_id
+    WHERE scc.visit_group_concept_id != 0
+    ORDER BY scc.visit_group_concept_id;"
+
+    visitTypeNames <- DatabaseConnector::renderTranslateQuerySql(
+        connection = connection,
+        sql = sql,
+        vocabularyDatabaseSchema = vocabularyDatabaseSchema,
+        resultsDatabaseSchema = resultsDatabaseSchema,
+        stratifiedCodeCountsTable = stratifiedCodeCountsTable
+    ) |>
+        tibble::as_tibble()
+
+    return(visitTypeNames)
+}
+
+#' Memoised version of getVisitTypeNames
+#'
+#' @description
+#' A memoised version of the getVisitTypeNames function that caches results to improve performance
+#' for repeated calls with the same parameters. The CDMdbHandler argument is omitted from
+#' the cache key to allow sharing across different database connections.
+#'
+#' @param CDMdbHandler A CDMdbHandler object that contains database connection details
+#' @param stratifiedCodeCountsTable Name of the stratified code counts table. Defaults to "stratified_code_counts"
+#'
+#' @importFrom memoise memoise
+#' 
+#' @return A tibble with columns:
+#' \itemize{
+#'   \item `visitGroupConceptId` - The visit group concept ID
+#'   \item `conceptCode` - The OMOP concept code
+#'   \item `conceptName` - The human-readable concept name
+#' }
+#'
+#' @export
+getVisitTypeNames_memoise <- memoise::memoise(
+    getVisitTypeNames,
+    omit_args = "CDMdbHandler"
+)

R/helper.R

@@ -99,7 +99,6 @@ helper_FinnGen_getDatabaseFileCounts <- function() {
 
 
 
-
 #' Create SQLite database from CDM database
 #'
 #' @description
@@ -160,13 +159,21 @@ helper_createSqliteDatabaseFromDatabase <- function(
 
   # Get concept table
   sql <- "SELECT DISTINCT c.* FROM @vocabularyDatabaseSchema.concept c
-          WHERE c.concept_id IN (@conceptIdsToExtract)"
-
+          WHERE c.concept_id IN (@conceptIdsToExtract)
+          -- Include also the concepts in visit_group_concept_id in stratified_code_counts table
+          UNION
+          SELECT DISTINCT c.* FROM @vocabularyDatabaseSchema.concept c
+          JOIN @resultsDatabaseSchema.@stratifiedCodeCountsTable scc ON c.concept_id = scc.visit_group_concept_id
+          WHERE scc.concept_id IN (@conceptIdsToExtract) OR scc.maps_to_concept_id IN (@conceptIdsToExtract)
+          "
+
   concept <- DatabaseConnector::renderTranslateQuerySql(
     connection = sourceConnection,
     sql = sql,
     vocabularyDatabaseSchema = sourceVocabularyDatabaseSchema,
-    conceptIdsToExtract = paste(conceptIdsToExtract, collapse = ",")
+    conceptIdsToExtract = paste(conceptIdsToExtract, collapse = ","),
+    resultsDatabaseSchema = sourceResultsDatabaseSchema,
+    stratifiedCodeCountsTable = paste0("stratified_", codeCountsTable)
   ) |>
     tibble::as_tibble()
 

R/runApiServer.R

@@ -47,11 +47,11 @@ runApiServer <- function(
         ParallelLogger::logInfo("No path to database config provided. Using the test counts only database.")
         # if not provided, use the test counts only database
         test_databasesConfig <- HadesExtras_readAndParseYaml(
-            pathToYalmFile = system.file("testdata", "config", "onlyCounts_databasesConfig.yml", package = "ROMOPAPI"),
+            pathToYalmFile = system.file("testdata", "config", "databasesConfig.yml", package = "ROMOPAPI"),
             pathToFinnGenCountsSqlite = helper_FinnGen_getDatabaseFileCounts()
         )
 
-        cohortTableHandlerConfig <- test_databasesConfig[[1]]$cohortTableHandler
+        cohortTableHandlerConfig <- test_databasesConfig$FC$cohortTableHandler
 
         # Create CDMdbHandler
         CDMdbHandler <- HadesExtras_createCDMdbHandlerFromList(cohortTableHandlerConfig, loadConnectionChecksLevel = "basicChecks")

inst/plumber/plumber.R

@@ -125,4 +125,10 @@ function(res, feedback = "") {
   sendFeedback(feedback)
   res$status <- 200
   return(list(message = "Feedback sent"))
+}
+
+#* Get the list of visit type names
+#* @get /getVisitTypeNames
+function() {
+  getVisitTypeNames_memoise(CDMdbHandler = CDMdbHandler)
 }

inst/sql/sql_server/appendToStratrifiedCodeCountsTable.sql

@@ -1,10 +1,11 @@
 -- Insert into code_stratified_counts table
 INSERT INTO @resultsDatabaseSchema.@stratifiedCodeCountsTable
 
--- calculate counts per each group of concept_id, calendar_year, gender_concept_id, age_decil
+-- calculate counts per each group of concept_id, calendar_year, gender_concept_id, age_decil, visit_group_concept_id
 SELECT 
         CAST(ccm.concept_id AS BIGINT) AS concept_id,
         CAST(ccm.maps_to_concept_id AS BIGINT) AS maps_to_concept_id,
+        CAST(ccm.visit_group_concept_id AS BIGINT) AS visit_group_concept_id,
         CAST(ccm.calendar_year AS BIGINT) AS calendar_year,
         CAST(ccm.gender_concept_id AS BIGINT) AS gender_concept_id,
         CAST(ccm.age_decile AS BIGINT) AS age_decile,
@@ -13,13 +14,17 @@ FROM (
         -- get all person_ids with the concept_id with in a valid observation period
         -- calculate the calendar year, gender_concept_id, age_decile
         -- calculate the min_calendar_year, used to find the first event in history  per code and person 
+        -- if visit_source_group_concept_ids are provided, calculate the visit_group_concept_id based on the given groups, 
+        --   if not on a given visit_group_concept_id keep the original visit_source_concept_id as visit_group_concept_id
+        --   if not event has a visit_occurrence_id or visit_source_concept_id, assign 0 as visit_group_concept_id
         SELECT 
                 p.person_id AS person_id,
                 t.@concept_id_field AS concept_id,
                 t.@maps_to_concept_id_field AS maps_to_concept_id,
                 YEAR(t.@date_field) AS calendar_year,
                 p.gender_concept_id AS gender_concept_id,
-                FLOOR((YEAR(t.@date_field) - p.year_of_birth) / 10) AS age_decile
+                FLOOR((YEAR(t.@date_field) - p.year_of_birth) / 10) AS age_decile,
+                {@visit_group_concept_ids != 0} ? {COALESCE(vmap.visit_group_concept_id, vo.visit_source_concept_id)} : {0} AS visit_group_concept_id
         FROM
                 @cdmDatabaseSchema.person p
         JOIN 
@@ -34,6 +39,24 @@ FROM (
                 t.@date_field >= op.observation_period_start_date
         AND 
                 t.@date_field <= op.observation_period_end_date
+{@visit_group_concept_ids != 0}?{
+        LEFT JOIN 
+                @cdmDatabaseSchema.visit_occurrence vo
+        ON 
+                t.visit_occurrence_id = vo.visit_occurrence_id
+        LEFT JOIN (
+                SELECT 
+                        ca.ancestor_concept_id AS visit_group_concept_id,
+                        ca.descendant_concept_id AS visit_source_concept_id
+                FROM
+                        @cdmDatabaseSchema.concept_ancestor ca
+                WHERE
+                        ca.ancestor_concept_id IN (@visit_group_concept_ids)
+
+        ) AS vmap
+        ON
+                vo.visit_source_concept_id = vmap.visit_source_concept_id
+}
         WHERE
                 t.@concept_id_field != 0
 ) ccm
@@ -42,4 +65,5 @@ GROUP BY
         ccm.maps_to_concept_id,
         ccm.calendar_year,
         ccm.gender_concept_id,
-        ccm.age_decile
+        ccm.age_decile,
+        ccm.visit_group_concept_id;