Mock cohort set function

R/CohortDefinitionSet.R

@@ -0,0 +1,43 @@
+.decodeBase64 <- function(x) {
+ rawToChar(base64enc::base64decode(x))
+}
+
+#' Get Mock Cohort definition set for subset of reward cohorts.
+#' @description
+#' Useful in other analysis steps with ohdsi packages
+#'
+#' @export
+#' @param rewardConfig Reward configuration
+#' @param cohortIds Cohort Identifiers
+getMockCohortDefinitionSet <- function(rewardConfig, cohortIds) {
+ connection <- DatabaseConnector::connect(rewardConfig$connectionDetails)
+ on.exit(DatabaseConnector::disconnect(connection))
+
+ sql <- "
+ SELECT
+ cd.cohort_definition_id as cohort_id,
+ cd.cohort_definition_name as cohort_name,
+ COALESCE(ar.sql_definition, '') as sql,
+ COALESCE(ar.definition, '') as json,
+ CASE WHEN ar.definition IS NULL THEN 0 ELSE 1 END as has_json
+ FROM @schema.@cohort_definition cd
+ LEFT JOIN @schema.@atlas_cohort_reference ar ON cd.cohort_definition_id = ar.cohort_definition_id
+ WHERE cd.cohort_definition_id IN (@cohort_ids)
+ "
+
+ res <- DatabaseConnector::renderTranslateQuerySql(connection,
+ sql,
+ cohort_ids = cohortIds,
+ schema = rewardConfig$resultsSchema,
+ atlas_cohort_reference = rewardConfig$referenceTables$atlasCohortReference,
+ cohort_definition = rewardConfig$referenceTables$cohortDefinition,
+ snakeCaseToCamelCase = TRUE)
+
+
+ res <- res %>%
+ dplyr::mutate(json = ifelse(.data$hasJson == 1, .decodeBase64(.data$json), "{}")) %>%
+ dplyr::mutate(sql = ifelse(.data$hasJson == 1, .decodeBase64(.data$sql), "")) %>%
+ dplyr::select(-"hasJson")
+
+ return(res)
+}