diff --git a/R/ConvertConceptSetDataFrameToExpression.R b/R/ConvertConceptSetDataFrameToExpression.R index 93f79c1..fcd0d0f 100644 --- a/R/ConvertConceptSetDataFrameToExpression.R +++ b/R/ConvertConceptSetDataFrameToExpression.R @@ -35,6 +35,8 @@ #' #' @template VocabularyDatabaseSchema #' +#' @template TempEmulationSchema +#' #' @return #' Returns a R list object #' @@ -45,7 +47,8 @@ convertConceptSetDataFrameToExpression <- updateVocabularyFields = FALSE, connectionDetails = NULL, connection = NULL, - vocabularyDatabaseSchema = NULL) { + vocabularyDatabaseSchema = NULL, + tempEmulationSchema = getOption("sqlRenderTempEmulationSchema")) { if (!"includeMapped" %in% colnames(conceptSetExpressionDataFrame)) { conceptSetExpressionDataFrame$includeMapped <- FALSE } @@ -92,7 +95,10 @@ convertConceptSetDataFrameToExpression <- } if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } conceptIds <- @@ -100,17 +106,24 @@ convertConceptSetDataFrameToExpression <- conceptIdDetails <- getConceptIdDetails( conceptIds = conceptIds, connection = connection, - vocabularyDatabaseSchema = vocabularyDatabaseSchema + vocabularyDatabaseSchema = vocabularyDatabaseSchema, + tempEmulationSchema = tempEmulationSchema ) conceptSetExpressionDataFrame <- conceptSetExpressionDataFrame |> dplyr::select( - -.data$conceptName, -.data$standardConcept, -.data$standardConceptCaption, -.data$invalidReason, -.data$invalidReasonCaption, -.data$conceptCode, -.data$domainId, -.data$vocabularyId, -.data$conceptClassId - ) |> - dplyr::left_join(conceptIdDetails, - by = "conceptId" + -.data$conceptName, + -.data$standardConcept, + -.data$standardConceptCaption, + -.data$invalidReason, + -.data$invalidReasonCaption, + -.data$conceptCode, + -.data$domainId, + -.data$vocabularyId, + -.data$conceptClassId ) |> + dplyr::left_join(conceptIdDetails, by = "conceptId") |> dplyr::select( .data$conceptId, .data$conceptName, @@ -165,7 +178,11 @@ convertConceptSetDataFrameToExpression <- conceptSetExpression$items[[i]] <- list() conceptSetExpression$items[[i]]$concept <- conceptSetExpressionDataFrame[i, ] |> - dplyr::select(-.data$INCLUDE_DESCENDANTS, -.data$INCLUDE_MAPPED, -.data$IS_EXCLUDED) |> + dplyr::select( + -.data$INCLUDE_DESCENDANTS, + -.data$INCLUDE_MAPPED, + -.data$IS_EXCLUDED + ) |> as.list() conceptSetExpression$items[[i]]$isExcluded <- conceptSetExpressionDataFrame$IS_EXCLUDED[i] diff --git a/R/ConvertConceptSetExpressionToDataFrame.R b/R/ConvertConceptSetExpressionToDataFrame.R index b1317fb..ff91ac3 100644 --- a/R/ConvertConceptSetExpressionToDataFrame.R +++ b/R/ConvertConceptSetExpressionToDataFrame.R @@ -118,7 +118,10 @@ convertConceptSetExpressionToDataFrame <- } if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } details <- getConceptIdDetails( diff --git a/R/ExtractConceptSetsInCohortDefinition.R b/R/ExtractConceptSetsInCohortDefinition.R index e51546a..7e707ce 100644 --- a/R/ExtractConceptSetsInCohortDefinition.R +++ b/R/ExtractConceptSetsInCohortDefinition.R @@ -57,7 +57,7 @@ extractConceptSetsInCohortDefinition <- primaryCriterias <- expression$PrimaryCriteria$CriteriaList codeSetsIdsInPrimaryCriteria <- c() - + codeSetsIdsUsedToQuerySourceConceptsInPrimaryCriteria <- c() for (i in (1:length(primaryCriterias))) { @@ -72,36 +72,36 @@ extractConceptSetsInCohortDefinition <- unique() |> sort() } - + # Find the name of the item containing 'SourceConcept' - sourceConceptName <- names(codesets)[sapply(names(codesets), function(x) - grepl("SourceConcept", x)) & - !sapply(codesets, is.null)] - + sourceConceptName <- names(codesets)[sapply(names(codesets), function(x) { + grepl("SourceConcept", x) + }) & + !sapply(codesets, is.null)] + if (length(sourceConceptName) > 0) { codeSetsIdsInPrimaryCriteria <- c(codeSetsIdsInPrimaryCriteria, codesets[[sourceConceptName]]) |> unique() |> sort() } - + sourceConceptName <- NULL - + codeSetsIdsUsedToQuerySourceConceptsInPrimaryCriteria <- c( codeSetsIdsUsedToQuerySourceConceptsInPrimaryCriteria, codeSetsIdsInPrimaryCriteria ) - } else { if (any( names(codesets) == "CodesetId", - stringr::str_detect(string = names(codesets), pattern = 'SourceConcept') + stringr::str_detect(string = names(codesets), pattern = "SourceConcept") )) { - #is substring of name 'SourceConcept' + # is substring of name 'SourceConcept' codeSetsIdsInPrimaryCriteria <- c(codeSetsIdsInPrimaryCriteria, as.double(codesets)) |> unique() |> sort() - - if (!names(codesets) == 'CodesetId') { + + if (!names(codesets) == "CodesetId") { codeSetsIdsUsedToQuerySourceConceptsInPrimaryCriteria <- c( codeSetsIdsUsedToQuerySourceConceptsInPrimaryCriteria, codeSetsIdsInPrimaryCriteria @@ -365,32 +365,33 @@ extractConceptSetsInCohortDefinition <- conceptSetExpression <- dplyr::bind_rows(conceptSetExpression2) |> - dplyr::mutate(conceptSetUsedInEntryEvent = 0) |> + dplyr::mutate(conceptSetUsedInEntryEvent = 0) |> dplyr::mutate(conceptSetUsedInEntryEventToQuerySource = 0) if (length(codeSetsIdsInPrimaryCriteria) > 0) { - conceptSetExpression <- conceptSetExpression |> - dplyr::select(-dplyr::all_of(c("conceptSetUsedInEntryEvent", - "conceptSetUsedInEntryEventToQuerySource"))) |> + dplyr::select(-dplyr::all_of(c( + "conceptSetUsedInEntryEvent", + "conceptSetUsedInEntryEventToQuerySource" + ))) |> dplyr::left_join( dplyr::tibble(conceptSetId = codeSetsIdsInPrimaryCriteria) |> dplyr::distinct() |> dplyr::mutate(conceptSetUsedInEntryEvent = 1), by = "conceptSetId" - ) - - if (length(codeSetsIdsUsedToQuerySourceConceptsInPrimaryCriteria) > 0) { - conceptSetExpression <- conceptSetExpression |> - dplyr::left_join( - dplyr::tibble(conceptSetId = codeSetsIdsUsedToQuerySourceConceptsInPrimaryCriteria) |> - dplyr::distinct() |> - dplyr::mutate(conceptSetUsedInEntryEventToQuerySource = 1), - by = ("conceptSetId") - ) - } else { - conceptSetExpression$conceptSetUsedInEntryEventToQuerySource <- as.integer(0) - } + ) + + if (length(codeSetsIdsUsedToQuerySourceConceptsInPrimaryCriteria) > 0) { + conceptSetExpression <- conceptSetExpression |> + dplyr::left_join( + dplyr::tibble(conceptSetId = codeSetsIdsUsedToQuerySourceConceptsInPrimaryCriteria) |> + dplyr::distinct() |> + dplyr::mutate(conceptSetUsedInEntryEventToQuerySource = 1), + by = ("conceptSetId") + ) + } else { + conceptSetExpression$conceptSetUsedInEntryEventToQuerySource <- as.integer(0) + } } uniqueConceptSets <- conceptSetExpression |> @@ -411,8 +412,10 @@ extractConceptSetsInCohortDefinition <- ) data <- data |> - tidyr::replace_na(replace = list(conceptSetUsedInEntryEvent = 0, - conceptSetUsedInEntryEventToQuerySource = 0)) + tidyr::replace_na(replace = list( + conceptSetUsedInEntryEvent = 0, + conceptSetUsedInEntryEventToQuerySource = 0 + )) data <- data |> dplyr::left_join(conceptSetExpressionMetaData, diff --git a/R/ExtractConceptSetsInCohortDefinitionSet.R b/R/ExtractConceptSetsInCohortDefinitionSet.R index 438ddec..558ce76 100644 --- a/R/ExtractConceptSetsInCohortDefinitionSet.R +++ b/R/ExtractConceptSetsInCohortDefinitionSet.R @@ -32,16 +32,18 @@ extractConceptSetsInCohortDefinitionSet <- function(cohortDefinitionSet) { # cohorts should be a dataframe with at least cohortId and json - + conceptSets <- list() for (i in (1:nrow(cohortDefinitionSet))) { cohort <- cohortDefinitionSet[i, ] cohortJsonAsList <- RJSONIO::fromJSON(content = cohort$json, digits = 23) conceptSetsInCohortDefinition <- NULL conceptSetsInCohortDefinition <- - try(expr = extractConceptSetsInCohortDefinition(cohortExpression = cohortJsonAsList), - silent = TRUE) - + try( + expr = extractConceptSetsInCohortDefinition(cohortExpression = cohortJsonAsList), + silent = TRUE + ) + if (all( !is.null(conceptSetsInCohortDefinition), !class(conceptSetsInCohortDefinition) == "try-error" @@ -55,13 +57,13 @@ extractConceptSetsInCohortDefinitionSet <- } conceptSets <- dplyr::bind_rows(conceptSets) |> dplyr::arrange("cohortId", "conceptSetId") - + conceptSetSig <- list() for (i in (1:nrow(conceptSets))) { conceptSetSig[[i]] <- conceptSets[i, ] conceptSetExpressionSignature <- convertConceptSetExpressionToDataFrame(conceptSetExpression = conceptSetSig[[i]]$conceptSetExpression |> - RJSONIO::fromJSON(digits = 23)) |> + RJSONIO::fromJSON(digits = 23)) |> dplyr::select( .data$conceptId, .data$includeDescendants, @@ -74,9 +76,11 @@ extractConceptSetsInCohortDefinitionSet <- conceptSetSig[[i]]$conceptSetExpressionSignature <- conceptSetExpressionSignature conceptSetSig[[i]] <- conceptSetSig[[i]] |> - dplyr::select(.data$cohortId, - .data$conceptSetId, - .data$conceptSetExpressionSignature) |> + dplyr::select( + .data$cohortId, + .data$conceptSetId, + .data$conceptSetExpressionSignature + ) |> dplyr::distinct() } conceptSetSig <- dplyr::bind_rows(conceptSetSig) @@ -84,20 +88,24 @@ extractConceptSetsInCohortDefinitionSet <- dplyr::select(.data$conceptSetExpressionSignature) |> dplyr::distinct() |> dplyr::mutate(uniqueConceptSetId = dplyr::row_number()) - + conceptSetSig <- conceptSetSig |> dplyr::inner_join(uniqueConceptSets, by = "conceptSetExpressionSignature") |> dplyr::select(-.data$conceptSetExpressionSignature) - + conceptSets <- conceptSets |> - dplyr::select(-uniqueConceptSetId) |> + dplyr::select(-"uniqueConceptSetId") |> dplyr::left_join(conceptSetSig, by = c("cohortId", "conceptSetId")) |> dplyr::distinct() |> - dplyr::relocate(.data$uniqueConceptSetId, - .data$cohortId, - .data$conceptSetId) |> - dplyr::arrange(.data$uniqueConceptSetId, - .data$cohortId, - .data$conceptSetId) + dplyr::relocate( + .data$uniqueConceptSetId, + .data$cohortId, + .data$conceptSetId + ) |> + dplyr::arrange( + .data$uniqueConceptSetId, + .data$cohortId, + .data$conceptSetId + ) return(conceptSets) } diff --git a/R/FindOrphanConcepts.R b/R/FindOrphanConcepts.R index 4917553..21409b3 100644 --- a/R/FindOrphanConcepts.R +++ b/R/FindOrphanConcepts.R @@ -39,7 +39,10 @@ findOrphanConcepts <- function(connectionDetails = NULL, conceptIds) { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } tempTableName <- loadTempConceptTable( diff --git a/R/GetConceptAncestor.R b/R/GetConceptAncestor.R index 931af12..15995b4 100644 --- a/R/GetConceptAncestor.R +++ b/R/GetConceptAncestor.R @@ -40,7 +40,10 @@ getConceptAncestor <- vocabularyDatabaseSchema = "vocabulary") { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } tempTableName <- loadTempConceptTable( diff --git a/R/GetConceptDescendant.R b/R/GetConceptDescendant.R index e92618b..0ec6bab 100644 --- a/R/GetConceptDescendant.R +++ b/R/GetConceptDescendant.R @@ -40,7 +40,10 @@ getConceptDescendant <- vocabularyDatabaseSchema = "vocabulary") { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } tempTableName <- loadTempConceptTable( diff --git a/R/GetConceptIdDetails.R b/R/GetConceptIdDetails.R index ce90a32..ae99351 100644 --- a/R/GetConceptIdDetails.R +++ b/R/GetConceptIdDetails.R @@ -40,7 +40,10 @@ getConceptIdDetails <- tempEmulationSchema = getOption("sqlRenderTempEmulationSchema")) { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } tempTableName <- loadTempConceptTable( diff --git a/R/GetConceptPrevalenceCounts.R b/R/GetConceptPrevalenceCounts.R index 142ff63..38741cf 100644 --- a/R/GetConceptPrevalenceCounts.R +++ b/R/GetConceptPrevalenceCounts.R @@ -40,7 +40,10 @@ getConceptPrevalenceCounts <- function(conceptIds = NULL, tempEmulationSchema = getOption("sqlRenderTempEmulationSchema")) { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } conceptPrevalenceTables <- diff --git a/R/GetConceptRecordCount.R b/R/GetConceptRecordCount.R index b90a3b8..003a4eb 100644 --- a/R/GetConceptRecordCount.R +++ b/R/GetConceptRecordCount.R @@ -90,7 +90,10 @@ getConceptRecordCount <- function(conceptIds = NULL, )) { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } uploadedConceptTable <- "" diff --git a/R/GetConceptRelationship.R b/R/GetConceptRelationship.R index 266205a..9bb9c9c 100644 --- a/R/GetConceptRelationship.R +++ b/R/GetConceptRelationship.R @@ -37,7 +37,10 @@ getConceptRelationship <- vocabularyDatabaseSchema = "vocabulary") { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } tempTableName <- loadTempConceptTable( diff --git a/R/GetConceptSynonym.R b/R/GetConceptSynonym.R index 9d86231..f208aca 100644 --- a/R/GetConceptSynonym.R +++ b/R/GetConceptSynonym.R @@ -37,7 +37,10 @@ getConceptSynonym <- vocabularyDatabaseSchema = "vocabulary") { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } tempTableName <- loadTempConceptTable( diff --git a/R/GetCountOfSourceCodesMappedToStandardConcept.R b/R/GetCountOfSourceCodesMappedToStandardConcept.R index eaa5e9d..8759fbc 100644 --- a/R/GetCountOfSourceCodesMappedToStandardConcept.R +++ b/R/GetCountOfSourceCodesMappedToStandardConcept.R @@ -43,7 +43,10 @@ getCountOfSourceCodesMappedToStandardConcept <- function(conceptIds, minCellCount = 0) { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } tempTableName <- loadTempConceptTable( diff --git a/R/GetDomain.R b/R/GetDomain.R index c8b4b2b..0ae4cff 100644 --- a/R/GetDomain.R +++ b/R/GetDomain.R @@ -24,6 +24,8 @@ #' #' @template VocabularyDatabaseSchema #' +#' @template TempEmulationSchema +#' #' @return #' Returns a tibble data frame. #' @@ -31,10 +33,14 @@ getDomain <- function(connection = NULL, connectionDetails = NULL, - vocabularyDatabaseSchema = "vocabulary") { + vocabularyDatabaseSchema = "vocabulary", + tempEmulationSchema = getOption("sqlRenderTempEmulationSchema")) { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } data <- @@ -42,6 +48,7 @@ getDomain <- connection = connection, sql = "SELECT * FROM @vocabulary_database_schema.domain;", vocabulary_database_schema = vocabularyDatabaseSchema, + tempEmulationSchema = tempEmulationSchema, snakeCaseToCamelCase = TRUE ) |> tidyr::tibble() diff --git a/R/GetDrugIngredients.R b/R/GetDrugIngredients.R index 9e9ba59..814b6a3 100644 --- a/R/GetDrugIngredients.R +++ b/R/GetDrugIngredients.R @@ -39,7 +39,10 @@ getDrugIngredients <- vocabularyDatabaseSchema = "vocabulary") { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } tempTableName <- loadTempConceptTable( diff --git a/R/GetExcludedConceptIdsInConceptSetExpression.R b/R/GetExcludedConceptIdsInConceptSetExpression.R index 5e5b9fc..f0f76bb 100644 --- a/R/GetExcludedConceptIdsInConceptSetExpression.R +++ b/R/GetExcludedConceptIdsInConceptSetExpression.R @@ -40,7 +40,10 @@ getExcludedConceptsInConceptSetExpression <- vocabularyDatabaseSchema = "vocabulary") { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } conceptSetDataFrame <- diff --git a/R/GetMappedSourceConcepts.R b/R/GetMappedSourceConcepts.R index b8cedb0..7c2c005 100644 --- a/R/GetMappedSourceConcepts.R +++ b/R/GetMappedSourceConcepts.R @@ -40,7 +40,10 @@ getMappedSourceConcepts <- vocabularyDatabaseSchema = "vocabulary") { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } tempTableName <- loadTempConceptTable( diff --git a/R/GetMappedStandardConcepts.R b/R/GetMappedStandardConcepts.R index 26a1c70..bad4165 100644 --- a/R/GetMappedStandardConcepts.R +++ b/R/GetMappedStandardConcepts.R @@ -40,7 +40,10 @@ getMappedStandardConcepts <- vocabularyDatabaseSchema = "vocabulary") { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } tempTableName <- loadTempConceptTable( diff --git a/R/GetMedraRelationship.R b/R/GetMedraRelationship.R index a35dfb5..413d302 100644 --- a/R/GetMedraRelationship.R +++ b/R/GetMedraRelationship.R @@ -46,7 +46,10 @@ getMedraRelationship <- vocabularyDatabaseSchema = "vocabulary") { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } conceptAncestor <- getConceptAncestor( conceptIds = conceptIds, @@ -120,7 +123,8 @@ getMedraRelationship <- dplyr::filter(is.na(.data$invalidReason)) |> dplyr::filter(.data$conceptClassId == !!conceptClass) |> dplyr::rename( - !!paste0(tolower(conceptClass), "ConceptName") := .data$conceptName, !!paste0(tolower(conceptClass), "DomainId") := .data$domainId + !!paste0(tolower(conceptClass), "ConceptName") := .data$conceptName, + !!paste0(tolower(conceptClass), "DomainId") := .data$domainId ) |> dplyr::select( .data$conceptId, @@ -130,7 +134,10 @@ getMedraRelationship <- by = c("ancestorConceptId" = "conceptId") ) |> dplyr::rename(!!paste0(tolower(conceptClass), "ConceptId") := .data$ancestorConceptId) |> - dplyr::select(-.data$minLevelsOfSeparation, -.data$maxLevelsOfSeparation) + dplyr::select( + -.data$minLevelsOfSeparation, + -.data$maxLevelsOfSeparation + ) return(output) } ancestorSocForGivenConceptId <- @@ -157,19 +164,21 @@ getMedraRelationship <- dplyr::filter(is.na(.data$invalidReason)) |> dplyr::filter(.data$conceptClassId == !!conceptClass) |> dplyr::rename( - !!paste0(tolower(conceptClass), "ConceptName") := .data$conceptName, !!paste0(tolower(conceptClass), "DomainId") := .data$domainId + !!paste0(tolower(conceptClass), "ConceptName") := .data$conceptName, + !!paste0(tolower(conceptClass), "DomainId") := .data$domainId ) |> dplyr::select( .data$conceptId, - paste0( - tolower(conceptClass), "ConceptName" - ), + paste0(tolower(conceptClass), "ConceptName"), paste0(tolower(conceptClass), "DomainId") ), by = c("descendantConceptId" = "conceptId") ) |> dplyr::rename(!!paste0(tolower(conceptClass), "ConceptId") := .data$descendantConceptId) |> - dplyr::select(-.data$minLevelsOfSeparation, -.data$maxLevelsOfSeparation) + dplyr::select( + -.data$minLevelsOfSeparation, + -.data$maxLevelsOfSeparation + ) return(output) } descendantSocForGivenConceptId <- diff --git a/R/GetRecommendationStandard.R b/R/GetRecommendationStandard.R index dc41eba..78626a8 100644 --- a/R/GetRecommendationStandard.R +++ b/R/GetRecommendationStandard.R @@ -40,14 +40,14 @@ getRecommendedStandard <- if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } conceptPrevalenceTables <- - DatabaseConnector::getTableNames( - connection = connection, - databaseSchema = conceptPrevalenceSchema - ) |> + DatabaseConnector::getTableNames(connection = connection, databaseSchema = conceptPrevalenceSchema) |> tolower() conceptPrevalenceTablesExist <- FALSE diff --git a/R/GetRecommendedSource.R b/R/GetRecommendedSource.R index 90e3139..08fa9d2 100644 --- a/R/GetRecommendedSource.R +++ b/R/GetRecommendedSource.R @@ -40,14 +40,14 @@ getRecommendedSource <- if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } conceptPrevalenceTables <- - DatabaseConnector::getTableNames( - connection = connection, - databaseSchema = conceptPrevalenceSchema - ) |> + DatabaseConnector::getTableNames(connection = connection, databaseSchema = conceptPrevalenceSchema) |> tolower() conceptPrevalenceTablesExist <- FALSE diff --git a/R/GetRelationship.R b/R/GetRelationship.R index 3b72f7c..e27ae93 100644 --- a/R/GetRelationship.R +++ b/R/GetRelationship.R @@ -21,14 +21,20 @@ #' #' @template VocabularyDatabaseSchema #' +#' @template TempEmulationSchema +#' #' @export getRelationship <- function(connection = NULL, connectionDetails = NULL, - vocabularyDatabaseSchema = "vocabulary") { + vocabularyDatabaseSchema = "vocabulary", + tempEmulationSchema = getOption("sqlRenderTempEmulationSchema")) { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } data <- @@ -36,6 +42,7 @@ getRelationship <- connection = connection, sql = "SELECT * FROM @vocabulary_database_schema.relationship;", vocabulary_database_schema = vocabularyDatabaseSchema, + tempEmulationSchema = tempEmulationSchema, snakeCaseToCamelCase = TRUE ) |> tidyr::tibble() diff --git a/R/GetVocabulary.R b/R/GetVocabulary.R index 065f940..64567d1 100644 --- a/R/GetVocabulary.R +++ b/R/GetVocabulary.R @@ -21,14 +21,20 @@ #' #' @template VocabularyDatabaseSchema #' +#' @template TempEmulationSchema +#' #' @export getVocabulary <- function(connection = NULL, connectionDetails = NULL, - vocabularyDatabaseSchema = "vocabulary") { + vocabularyDatabaseSchema = "vocabulary", + tempEmulationSchema = getOption("sqlRenderTempEmulationSchema")) { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } output <- @@ -36,6 +42,7 @@ getVocabulary <- connection = connection, sql = "SELECT * FROM @vocabulary_database_schema.vocabulary;", vocabulary_database_schema = vocabularyDatabaseSchema, + tempEmulationSchema = tempEmulationSchema, snakeCaseToCamelCase = TRUE ) |> tidyr::tibble() diff --git a/R/GetVocabularyVersion.R b/R/GetVocabularyVersion.R index 82f7105..c7b1961 100644 --- a/R/GetVocabularyVersion.R +++ b/R/GetVocabularyVersion.R @@ -21,14 +21,20 @@ #' #' @template VocabularyDatabaseSchema #' +#' @template TempEmulationSchema +#' #' @export getVocabularyVersion <- function(connection = NULL, connectionDetails = NULL, - vocabularyDatabaseSchema = "vocabulary") { + vocabularyDatabaseSchema = "vocabulary", + tempEmulationSchema = getOption("sqlRenderTempEmulationSchema")) { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } data <- @@ -38,6 +44,7 @@ getVocabularyVersion <- from @vocabulary_database_schema.vocabulary where VOCABULARY_ID = 'None';", vocabulary_database_schema = vocabularyDatabaseSchema, + tempEmulationSchema = tempEmulationSchema, snakeCaseToCamelCase = TRUE ) |> tidyr::tibble() diff --git a/R/InstantiateCohortFromConceptSetExpression.R b/R/InstantiateCohortFromConceptSetExpression.R index f838c7b..ae061ac 100644 --- a/R/InstantiateCohortFromConceptSetExpression.R +++ b/R/InstantiateCohortFromConceptSetExpression.R @@ -59,7 +59,10 @@ instantiateCohortFromConceptSetExpression <- conceptSetExpression) { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } conceptIds <- diff --git a/R/MapMedraToSnomedViaVocabulary.R b/R/MapMedraToSnomedViaVocabulary.R index f50a887..2a8829c 100644 --- a/R/MapMedraToSnomedViaVocabulary.R +++ b/R/MapMedraToSnomedViaVocabulary.R @@ -42,16 +42,15 @@ mapMedraToSnomedViaVocabulary <- vocabularyDatabaseSchema = "vocabulary") { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } givenConceptId <- dplyr::tibble(medDraConceptId = conceptIds |> unique()) - writeLines(paste0( - "Found ", - scales::comma(nrow(givenConceptId)), - " concept ids." - )) + writeLines(paste0("Found ", scales::comma(nrow(givenConceptId)), " concept ids.")) medDraRelationship <- getMedraRelationship( conceptIds = givenConceptId$medDraConceptId, @@ -81,9 +80,7 @@ mapMedraToSnomedViaVocabulary <- dplyr::filter(.data$givenConceptClassId == "LLT") |> dplyr::select(.data$givenConceptId) |> dplyr::distinct() |> - dplyr::inner_join(medDraRelationship$pt, - by = "givenConceptId" - ) |> + dplyr::inner_join(medDraRelationship$pt, by = "givenConceptId") |> dplyr::select(.data$givenConceptId, .data$ptConceptId) |> dplyr::distinct() |> dplyr::rename("medDraConceptId" = .data$ptConceptId) @@ -100,10 +97,7 @@ mapMedraToSnomedViaVocabulary <- givenConceptId |> dplyr::inner_join( medDraRelationship$givenConceptId |> - dplyr::select( - .data$givenConceptId, - .data$givenConceptName - ) |> + dplyr::select(.data$givenConceptId, .data$givenConceptName) |> rename( "medDraConceptId" = .data$givenConceptId, "medDraConceptName" = .data$givenConceptName @@ -114,9 +108,9 @@ mapMedraToSnomedViaVocabulary <- givenConceptId |> dplyr::inner_join( medDraRelationship$pt |> - dplyr::select( - dplyr::all_of(c("givenConceptId", "ptConceptName")) - ) |> + dplyr::select(dplyr::all_of(c( + "givenConceptId", "ptConceptName" + ))) |> rename( "medDraConceptId" = .data$givenConceptId, "medDraConceptName" = .data$ptConceptName @@ -127,9 +121,9 @@ mapMedraToSnomedViaVocabulary <- givenConceptId |> dplyr::inner_join( medDraRelationship$llt |> - dplyr::select( - dplyr::all_of(c("givenConceptId", "lltConceptName")) - ) |> + dplyr::select(dplyr::all_of(c( + "givenConceptId", "lltConceptName" + ))) |> rename( "medDraConceptId" = .data$givenConceptId, "medDraConceptName" = .data$lltConceptName @@ -219,9 +213,7 @@ mapMedraToSnomedViaVocabulary <- relatedToSnomed <- medDraRelated |> - dplyr::select( - dplyr::all_of(c("conceptId1", "conceptId2")) - ) |> + dplyr::select(dplyr::all_of(c("conceptId1", "conceptId2"))) |> dplyr::distinct() |> dplyr::inner_join( conceptIdDetails |> @@ -244,16 +236,13 @@ mapMedraToSnomedViaVocabulary <- relatedToSnomedWithInvalid <- relatedToSnomed |> dplyr::filter(!is.na(.data$invalidReason)) |> - dplyr::select( - .data$medDraConceptId, - .data$snomedConceptId - ) |> + dplyr::select(.data$medDraConceptId, .data$snomedConceptId) |> dplyr::rename("invalidSnomedConceptId" = .data$snomedConceptId) |> dplyr::inner_join( conceptRelationship |> - dplyr::select( - dplyr::all_of(c("conceptId1", "conceptId2")) - ), + dplyr::select(dplyr::all_of(c( + "conceptId1", "conceptId2" + ))), by = c("invalidSnomedConceptId" = "conceptId1") ) |> dplyr::rename("snomedConceptId" = .data$conceptId2) |> @@ -261,10 +250,7 @@ mapMedraToSnomedViaVocabulary <- finalMappedConcepts <- dplyr::bind_rows( - dplyr::bind_rows( - relatedToSnomedWithInvalid, - relatedToSnomedWithValid - ) |> + dplyr::bind_rows(relatedToSnomedWithInvalid, relatedToSnomedWithValid) |> dplyr::distinct() |> dplyr::mutate( minLevelsOfSeparation = 0, @@ -290,10 +276,7 @@ mapMedraToSnomedViaVocabulary <- dplyr::distinct() |> dplyr::inner_join( conceptIdDetails |> - dplyr::select( - .data$conceptId, - .data$conceptName - ), + dplyr::select(.data$conceptId, .data$conceptName), by = "conceptId" ), finalMappedConcepts |> @@ -302,9 +285,9 @@ mapMedraToSnomedViaVocabulary <- dplyr::distinct() |> dplyr::inner_join( snomedSynonyms |> - dplyr::select( - dplyr::all_of(c("conceptId", "conceptSynonymName")) - ) |> + dplyr::select(dplyr::all_of(c( + "conceptId", "conceptSynonymName" + ))) |> dplyr::distinct() |> dplyr::rename("conceptName" = .data$conceptSynonymName), by = "conceptId" @@ -328,9 +311,7 @@ mapMedraToSnomedViaVocabulary <- by = "medDraConceptId" ), finalMappedConcepts |> - dplyr::inner_join(lltToPt, - by = "medDraConceptId" - ) |> + dplyr::inner_join(lltToPt, by = "medDraConceptId") |> dplyr::select(-.data$medDraConceptId) |> dplyr::rename("medDraConceptId" = .data$givenConceptId) ) |> @@ -352,10 +333,7 @@ mapMedraToSnomedViaVocabulary <- dplyr::inner_join( conceptIdDetails |> dplyr::filter(.data$vocabularyId == "MedDRA") |> - dplyr::select( - .data$conceptId, - .data$conceptClassId - ) |> + dplyr::select(.data$conceptId, .data$conceptClassId) |> dplyr::rename("medDraConceptClassId" = .data$conceptClassId) |> dplyr::distinct(), by = c("medDraConceptId" = "conceptId") @@ -363,27 +341,17 @@ mapMedraToSnomedViaVocabulary <- dplyr::inner_join( conceptIdDetails |> dplyr::filter(.data$vocabularyId == "SNOMED") |> - dplyr::select( - .data$conceptId, - .data$conceptClassId - ) |> + dplyr::select(.data$conceptId, .data$conceptClassId) |> dplyr::rename("snomedConceptClassId" = .data$conceptClassId) |> dplyr::distinct(), by = c("snomedConceptId" = "conceptId") ) computingStringDistanceScores <- finalMappedConcepts |> - dplyr::select( - .data$medDraConceptId, - .data$snomedConceptId - ) |> + dplyr::select(.data$medDraConceptId, .data$snomedConceptId) |> dplyr::distinct() |> # expand the medDra - dplyr::inner_join(medDraSynonyms, - by = "medDraConceptId" - ) |> # expand the snomed - dplyr::inner_join(snomedSynonyms, - by = "snomedConceptId" - ) + dplyr::inner_join(medDraSynonyms, by = "medDraConceptId") |> # expand the snomed + dplyr::inner_join(snomedSynonyms, by = "snomedConceptId") computingStringDistanceScores <- computingStringDistanceScores |> @@ -408,28 +376,33 @@ mapMedraToSnomedViaVocabulary <- false = .data$stringDistance1 ) ) |> - dplyr::select( - dplyr::all_of(c("medDraConceptId", "snomedConceptId", "stringDistanceScore")) - ) |> + dplyr::select(dplyr::all_of( + c( + "medDraConceptId", + "snomedConceptId", + "stringDistanceScore" + ) + )) |> dplyr::distinct() mappedUsingVocabaulary <- mappedUsingVocabaulary |> dplyr::left_join(computingStringDistanceScores, - by = c( - "medDraConceptId", - "snomedConceptId" - ) + by = c("medDraConceptId", "snomedConceptId") ) |> tidyr::replace_na(list(stringDistanceScore = 999)) |> dplyr::group_by(.data$medDraConceptId) |> - dplyr::arrange( - dplyr::all_of(c("minLevelsOfSeparation", "maxLevelsOfSeparation", "stringDistanceScore")) - ) |> + dplyr::arrange(dplyr::all_of( + c( + "minLevelsOfSeparation", + "maxLevelsOfSeparation", + "stringDistanceScore" + ) + )) |> dplyr::mutate(rank = dplyr::row_number()) |> dplyr::ungroup() |> - dplyr::select( - dplyr::all_of(c("medDraConceptId", "snomedConceptId", "rank")) - ) |> + dplyr::select(dplyr::all_of(c( + "medDraConceptId", "snomedConceptId", "rank" + ))) |> dplyr::distinct() writeLines("remove any descendants of snomed when parent is mapped") @@ -441,10 +414,7 @@ mapMedraToSnomedViaVocabulary <- ) listOfSnomeds <- mappedUsingVocabaulary |> - dplyr::select( - .data$medDraConceptId, - .data$snomedConceptId - ) |> + dplyr::select(.data$medDraConceptId, .data$snomedConceptId) |> dplyr::distinct() |> dplyr::arrange() @@ -454,81 +424,61 @@ mapMedraToSnomedViaVocabulary <- by = c("descendantConceptId" = "snomedConceptId") ) |> dplyr::inner_join(listOfSnomeds, - by = c( - "ancestorConceptId" = "snomedConceptId", - "medDraConceptId" - ) + by = c("ancestorConceptId" = "snomedConceptId", "medDraConceptId") ) |> dplyr::distinct() |> - dplyr::group_by( - .data$medDraConceptId, - .data$descendantConceptId - ) |> + dplyr::group_by(.data$medDraConceptId, .data$descendantConceptId) |> dplyr::arrange( dplyr::desc(.data$maxLevelsOfSeparation), dplyr::desc(.data$minLevelsOfSeparation) ) |> dplyr::mutate(ancestorRank = dplyr::row_number()) |> - dplyr::arrange( - dplyr::all_of(c("medDraConceptId", "descendantConceptId", "ancestorRank")) - ) + dplyr::arrange(dplyr::all_of( + c("medDraConceptId", "descendantConceptId", "ancestorRank") + )) canBeRolledUp <- mappedUsingVocabaulary |> dplyr::inner_join( conceptAncestorsForAllSnomedRanked, - by = c( - "snomedConceptId" = "descendantConceptId", - "medDraConceptId" - ) + by = c("snomedConceptId" = "descendantConceptId", "medDraConceptId") ) |> dplyr::rename("descendantConceptId" = .data$snomedConceptId) |> - dplyr::select( - dplyr::all_of(c("medDraConceptId", "descendantConceptId", "ancestorConceptId", "ancestorRank")) - ) |> + dplyr::select(dplyr::all_of( + c( + "medDraConceptId", + "descendantConceptId", + "ancestorConceptId", + "ancestorRank" + ) + )) |> dplyr::distinct() cannotBeRolledUp <- mappedUsingVocabaulary |> dplyr::anti_join( canBeRolledUp |> - dplyr::select( - .data$descendantConceptId, - .data$medDraConceptId - ) |> + dplyr::select(.data$descendantConceptId, .data$medDraConceptId) |> dplyr::rename("snomedConceptId" = .data$descendantConceptId) |> dplyr::distinct(), by = c("snomedConceptId", "medDraConceptId") ) |> - dplyr::select( - .data$medDraConceptId, - .data$snomedConceptId - ) |> + dplyr::select(.data$medDraConceptId, .data$snomedConceptId) |> dplyr::distinct() rolledUp <- canBeRolledUp |> dplyr::inner_join( suppressWarnings( canBeRolledUp |> - dplyr::select( - dplyr::all_of(c("medDraConceptId", "descendantConceptId", "ancestorRank")) - ) |> - dplyr::group_by( - .data$medDraConceptId, - .data$descendantConceptId - ) |> + dplyr::select(dplyr::all_of( + c("medDraConceptId", "descendantConceptId", "ancestorRank") + )) |> + dplyr::group_by(.data$medDraConceptId, .data$descendantConceptId) |> dplyr::summarise(ancestorRank = min(.data$ancestorRank)) ), - by = c( - "medDraConceptId", - "descendantConceptId", - "ancestorRank" - ) - ) |> - dplyr::select( - .data$medDraConceptId, - .data$ancestorConceptId + by = c("medDraConceptId", "descendantConceptId", "ancestorRank") ) |> + dplyr::select(.data$medDraConceptId, .data$ancestorConceptId) |> dplyr::rename("snomedConceptId" = .data$ancestorConceptId) |> dplyr::arrange(.data$medDraConceptId) |> dplyr::distinct() @@ -542,10 +492,7 @@ mapMedraToSnomedViaVocabulary <- by = c("medDraConceptId", "snomedConceptId") ) |> dplyr::distinct() |> - dplyr::group_by( - .data$medDraConceptId, - .data$snomedConceptId - ) |> + dplyr::group_by(.data$medDraConceptId, .data$snomedConceptId) |> dplyr::summarise(rank = min(.data$rank)) |> dplyr::ungroup(), cannotBeRolledUp |> @@ -554,10 +501,7 @@ mapMedraToSnomedViaVocabulary <- by = c("medDraConceptId", "snomedConceptId") ) |> dplyr::distinct() |> - dplyr::group_by( - .data$medDraConceptId, - .data$snomedConceptId - ) |> + dplyr::group_by(.data$medDraConceptId, .data$snomedConceptId) |> dplyr::summarise(rank = min(.data$rank)) |> dplyr::ungroup() ) @@ -571,14 +515,9 @@ mapMedraToSnomedViaVocabulary <- dplyr::ungroup() |> dplyr::arrange(.data$medDraConceptId) - mappedUsingVocabaulary <- dplyr::bind_rows( - rolledUp, - cannotBeRolledUp - ) |> + mappedUsingVocabaulary <- dplyr::bind_rows(rolledUp, cannotBeRolledUp) |> dplyr::distinct() |> - dplyr::left_join(reRank, - by = c("medDraConceptId", "snomedConceptId") - ) |> + dplyr::left_join(reRank, by = c("medDraConceptId", "snomedConceptId")) |> dplyr::inner_join( conceptIdDetails |> dplyr::select( @@ -611,16 +550,16 @@ mapMedraToSnomedViaVocabulary <- "medDraConceptClassId" = .data$givenConceptClassId, "medDraInvalidReason" = .data$givenConceptIdInvalidReason ) |> - dplyr::left_join(mappedUsingVocabaulary, - by = "medDraConceptId" - ) |> - dplyr::arrange( - dplyr::all_of(c("medDraConceptId", "medDraConceptName", "medDraConceptName", "rank")) - ) |> - dplyr::select( - dplyr::starts_with(c("medDra", "snomed")), - dplyr::all_of(c("rank")) - ) + dplyr::left_join(mappedUsingVocabaulary, by = "medDraConceptId") |> + dplyr::arrange(dplyr::all_of( + c( + "medDraConceptId", + "medDraConceptName", + "medDraConceptName", + "rank" + ) + )) |> + dplyr::select(dplyr::starts_with(c("medDra", "snomed")), dplyr::all_of(c("rank"))) return(mappedUsingVocabaulary) } diff --git a/R/OptimizeConceptSetExpression.R b/R/OptimizeConceptSetExpression.R index 4dd913a..eb20d9b 100644 --- a/R/OptimizeConceptSetExpression.R +++ b/R/OptimizeConceptSetExpression.R @@ -80,7 +80,10 @@ getOptimizationRecommendationForConceptSetExpression <- if (is.null(connection)) { if (!is.null(connectionDetails)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } } diff --git a/R/PerformConceptSetDiagnostics.R b/R/PerformConceptSetDiagnostics.R index 6747511..d6e2d27 100644 --- a/R/PerformConceptSetDiagnostics.R +++ b/R/PerformConceptSetDiagnostics.R @@ -59,7 +59,10 @@ performConceptSetDiagnostics <- if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } stringSearchResults <- performStringSearchForConcepts( @@ -176,18 +179,12 @@ performConceptSetDiagnostics <- recursive = TRUE ) unlink( - file.path( - locationForResults, - "conceptExpression.json" - ), + file.path(locationForResults, "conceptExpression.json"), recursive = TRUE, force = TRUE ) unlink( - file.path( - locationForResults, - "conceptExpression.csv" - ), + file.path(locationForResults, "conceptExpression.csv"), recursive = TRUE, force = TRUE ) @@ -199,17 +196,11 @@ performConceptSetDiagnostics <- digits = 23, pretty = TRUE ), - targetFile = file.path( - locationForResults, - "conceptExpression.json" - ) + targetFile = file.path(locationForResults, "conceptExpression.json") ) readr::write_excel_csv( x = convertConceptSetExpressionToDataFrame(conceptSetExpression = optimizedConceptSetExpression), - file = file.path( - locationForResults, - "conceptExpression.csv" - ), + file = file.path(locationForResults, "conceptExpression.csv"), na = "", append = FALSE ) @@ -217,57 +208,39 @@ performConceptSetDiagnostics <- unlink( - x = file.path( - locationForResults, - paste0("recommendedSource.csv") - ), + x = file.path(locationForResults, paste0("recommendedSource.csv")), recursive = TRUE, force = TRUE ) unlink( - x = file.path( - locationForResults, - paste0("recommendedStandard.csv") - ), + x = file.path(locationForResults, paste0("recommendedStandard.csv")), recursive = TRUE, force = TRUE ) if (!is.null(recommended)) { readr::write_excel_csv( x = recommended$recommendedStandard, - file = file.path( - locationForResults, - paste0("recommendedStandard.csv") - ), + file = file.path(locationForResults, paste0("recommendedStandard.csv")), append = FALSE, na = "" ) readr::write_excel_csv( x = recommended$recommendedSource, - file = file.path( - locationForResults, - paste0("recommendedSource.csv") - ), + file = file.path(locationForResults, paste0("recommendedSource.csv")), append = FALSE, na = "" ) } unlink( - x = file.path( - locationForResults, - paste0("orphan.csv") - ), + x = file.path(locationForResults, paste0("orphan.csv")), recursive = TRUE, force = TRUE ) if (!is.null(orphan)) { readr::write_excel_csv( x = orphan, - file = file.path( - locationForResults, - paste0("orphan.csv") - ), + file = file.path(locationForResults, paste0("orphan.csv")), append = FALSE, na = "" ) diff --git a/R/PerformStringSearchForConcepts.R b/R/PerformStringSearchForConcepts.R index aaeb3c3..6c40e5c 100644 --- a/R/PerformStringSearchForConcepts.R +++ b/R/PerformStringSearchForConcepts.R @@ -33,6 +33,8 @@ #' #' @param retrieveInvalidConcepts Do you want to retrieve invalid concepts. Default = FALSE #' +#' @template TempEmulationSchema +#' #' @export performStringSearchForConcepts <- function(searchPhrases, @@ -41,7 +43,8 @@ performStringSearchForConcepts <- connectionDetails = NULL, vocabularyIdOfInterest = c("SNOMED", "HCPCS", "ICD10CM", "ICD10", "ICD9CM", "ICD9", "Read"), domainIdOfInterest = c("Condition", "Procedure", "Observation"), - retrieveInvalidConcepts = FALSE) { + retrieveInvalidConcepts = FALSE, + tempEmulationSchema = getOption("sqlRenderTempEmulationSchema")) { if (!hasData(searchPhrases)) { writeLines(" - searchPhrases does not have data. No search performed.") return(NULL) @@ -68,14 +71,14 @@ performStringSearchForConcepts <- if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } fieldsInConceptTable <- - DatabaseConnector::dbListFields( - conn = connection, - name = "concept" - ) + DatabaseConnector::dbListFields(conn = connection, name = "concept") fieldsInConceptTable <- tolower(sort(unique(fieldsInConceptTable))) @@ -107,7 +110,8 @@ performStringSearchForConcepts <- packageName = "ConceptSetDiagnostics", dbms = connection@dbms, vocabulary_database_schema = vocabularyDatabaseSchema, - search_string = searchString + search_string = searchString, + tempEmulationSchema = tempEmulationSchema ) } data[[i]] <- diff --git a/R/ResolveConceptSetExpression.R b/R/ResolveConceptSetExpression.R index d48c2c7..c1a4f6a 100644 --- a/R/ResolveConceptSetExpression.R +++ b/R/ResolveConceptSetExpression.R @@ -36,11 +36,14 @@ resolveConceptSetExpression <- function(conceptSetExpression, vocabularyDatabaseSchema) { if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } - + conceptSetSql <- CirceR::buildConceptSetQuery(conceptSetJSON = conceptSetExpression |> RJSONIO::toJSON(digits = 23)) - + resolvedConceptIds <- DatabaseConnector::renderTranslateQuerySql( connection = connection, @@ -49,8 +52,8 @@ resolveConceptSetExpression <- function(conceptSetExpression, snakeCaseToCamelCase = TRUE, tempEmulationSchema = tempEmulationSchema ) |> - dplyr::distinct() |> - dplyr::arrange(conceptId) - + dplyr::distinct() |> + dplyr::arrange(dplyr::all_of("conceptId")) + return(resolvedConceptIds) } diff --git a/R/ResolveConceptSetsInCohortExpression.R b/R/ResolveConceptSetsInCohortExpression.R index 1f30580..65dada6 100644 --- a/R/ResolveConceptSetsInCohortExpression.R +++ b/R/ResolveConceptSetsInCohortExpression.R @@ -23,11 +23,14 @@ #' #' @template VocabularyDatabaseSchema #' +#' @template TempEmulationSchema +#' #' @export resolveConceptSetsInCohortExpression <- function(cohortExpression, connection = NULL, connectionDetails = NULL, - vocabularyDatabaseSchema = "vocabulary") { + vocabularyDatabaseSchema = "vocabulary", + tempEmulationSchema = getOption("sqlRenderTempEmulationSchema")) { conceptSetExpressionDataFrame <- extractConceptSetsInCohortDefinition( cohortExpression = @@ -36,7 +39,10 @@ resolveConceptSetsInCohortExpression <- function(cohortExpression, if (is.null(connection)) { connection <- DatabaseConnector::connect(connectionDetails) - on.exit(DatabaseConnector::disconnect(connection)) + on.exit( + DatabaseConnector::dropEmulatedTempTables(connection = connection, tempEmulationSchema = tempEmulationSchema) + ) + on.exit(DatabaseConnector::disconnect(connection), add = TRUE) } resolvedConceptSet <- list() @@ -47,6 +53,7 @@ resolveConceptSetsInCohortExpression <- function(cohortExpression, connection = connection, sql = sql, vocabulary_database_schema = vocabularyDatabaseSchema, + tempEmulationSchema = tempEmulationSchema, snakeCaseToCamelCase = TRUE ) } diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 51eb3db..8fa8a68 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -2,4 +2,4 @@ pandoc: 3.1.11 pkgdown: 2.1.0 pkgdown_sha: ~ articles: {} -last_built: 2024-09-13T11:03Z +last_built: 2024-09-30T15:55Z diff --git a/docs/reference/convertConceptSetDataFrameToExpression.html b/docs/reference/convertConceptSetDataFrameToExpression.html index c0801fe..bfbfe5e 100644 --- a/docs/reference/convertConceptSetDataFrameToExpression.html +++ b/docs/reference/convertConceptSetDataFrameToExpression.html @@ -53,7 +53,8 @@
The schema name of containing the vocabulary tables.
Some database platforms like Oracle and Impala do not truly support temp tables. To emulate temp +tables, provide a schema with write privileges where temp tables can be created.
Optional
Logical Whether to stratify the counts by gender.
Logical Whether to stratify the counts by year.
Logical Whether to stratify the counts by quarter of the year.
Logical Whether to stratify the counts by month of the year.
Logical Whether to stratify the counts by age group.
Logical Whether to limit the counts to first occurrences (incidence).
Logical Whether to include overall counts across all specified stratifications.
Vector of strings Domains to look for concept IDs. Supported domains +include "drug_exposure", "condition_occurrence", "procedure_occurrence", "measurement", "observation".
domains to look for concept id
An array of concept ids
options are "all", "first", "last"
Do you want to limit to person dates
getDomain(
connection = NULL,
connectionDetails = NULL,
- vocabularyDatabaseSchema = "vocabulary"
+ vocabularyDatabaseSchema = "vocabulary",
+ tempEmulationSchema = getOption("sqlRenderTempEmulationSchema")
)
The schema name of containing the vocabulary tables.
Some database platforms like Oracle and Impala do not truly support temp tables. To emulate temp +tables, provide a schema with write privileges where temp tables can be created.
getRelationship(
connection = NULL,
connectionDetails = NULL,
- vocabularyDatabaseSchema = "vocabulary"
+ vocabularyDatabaseSchema = "vocabulary",
+ tempEmulationSchema = getOption("sqlRenderTempEmulationSchema")
)
The schema name of containing the vocabulary tables.
Some database platforms like Oracle and Impala do not truly support temp tables. To emulate temp +tables, provide a schema with write privileges where temp tables can be created.
getVocabulary(
connection = NULL,
connectionDetails = NULL,
- vocabularyDatabaseSchema = "vocabulary"
+ vocabularyDatabaseSchema = "vocabulary",
+ tempEmulationSchema = getOption("sqlRenderTempEmulationSchema")
)
The schema name of containing the vocabulary tables.
Some database platforms like Oracle and Impala do not truly support temp tables. To emulate temp +tables, provide a schema with write privileges where temp tables can be created.
getVocabularyVersion(
connection = NULL,
connectionDetails = NULL,
- vocabularyDatabaseSchema = "vocabulary"
+ vocabularyDatabaseSchema = "vocabulary",
+ tempEmulationSchema = getOption("sqlRenderTempEmulationSchema")
)
The schema name of containing the vocabulary tables.
Some database platforms like Oracle and Impala do not truly support temp tables. To emulate temp +tables, provide a schema with write privileges where temp tables can be created.
Given a concept set expression, get the resolved concepts
Given a concept set expression, get the resolved concept ids.
The schema name of containing the vocabulary tables.
Schema name where your user has write access (has CRUD privileges). This is the location, +of the cohort tables.
An integer value to identify the cohort.
Do you want to retrieve invalid concepts. Default = FALSE
Some database platforms like Oracle and Impala do not truly support temp tables. To emulate temp +tables, provide a schema with write privileges where temp tables can be created.
resolveConceptSetExpression.Rd
Given a concept set expression, get the resolved concepts
+Given a concept set expression, get the resolved concept ids.
Returns a tibble data frame.
+Returns a tibble data frame of distinct sorted concept ids.
The schema name of containing the vocabulary tables.
Some database platforms like Oracle and Impala do not truly support temp tables. To emulate temp +tables, provide a schema with write privileges where temp tables can be created.