Merge pull request #504 from OHDSI/develop

Develop

Author: katy-sadowski

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: DataQualityDashboard
 Type: Package
 Title: Execute and View Data Quality Checks on OMOP CDM Database
-Version: 2.4.1
-Date: 2023-10-18
+Version: 2.5.0
+Date: 2023-11-04
 Authors@R: c(
   person("Katy", "Sadowski", email = "[email protected]", role = c("aut", "cre")),
   person("Clair", "Blacketer", role = c("aut")),

NAMESPACE

@@ -5,6 +5,7 @@ export(executeDqChecks)
 export(listDqChecks)
 export(reEvaluateThresholds)
 export(viewDqDashboard)
+export(writeDBResultsToJson)
 export(writeJsonResultsToCsv)
 export(writeJsonResultsToTable)
 import(DatabaseConnector)

R/executeDqChecks.R

@@ -94,6 +94,10 @@ executeDqChecks <- function(connectionDetails,
     stop("cdmVersion must contain a version of the form '5.X' where X is an integer between 2 and 4 inclusive.")
   }
 
+  if (sqlOnlyIncrementalInsert == TRUE && sqlOnly == FALSE) {
+    stop("Set `sqlOnly` to TRUE in order to use `sqlOnlyIncrementalInsert` mode.")
+  }
+
   stopifnot(is.character(cdmDatabaseSchema), is.character(resultsDatabaseSchema), is.numeric(numThreads))
   stopifnot(is.character(cdmSourceName), is.logical(sqlOnly), is.character(outputFolder), is.logical(verboseMode))
   stopifnot(is.logical(writeToTable), is.character(checkLevels))
@@ -134,6 +138,10 @@ executeDqChecks <- function(connectionDetails,
     if (nrow(metadata) < 1) {
       stop("Please populate the cdm_source table before executing data quality checks.")
     }
+    if (nrow(metadata) > 1) {
+      metadata <- metadata[1, ]
+      warning("The cdm_source table has more than 1 row. A single row from this table has been selected to populate DQD metadata.")
+    }
     metadata$dqdVersion <- as.character(packageVersion("DataQualityDashboard"))
     DatabaseConnector::disconnect(connection)
   } else {

R/runCheck.R

@@ -124,7 +124,7 @@
 
     dfs <- do.call(rbind, dfs)
 
-    if (sqlOnlyIncrementalInsert) {
+    if (sqlOnly && sqlOnlyIncrementalInsert) {
       sqlToUnion <- dfs$query
       if (length(sqlToUnion) > 0) {
         .writeSqlOnlyQueries(sqlToUnion, sqlOnlyUnionCount, resultsDatabaseSchema, writeTableName, connectionDetails$dbms, outputFolder, checkDescription)

R/writeDBResultsTo.R

@@ -0,0 +1,77 @@
+# Copyright 2023 Observational Health Data Sciences and Informatics
+#
+# This file is part of DataQualityDashboard
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+#     http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+#' Write DQD results database table to json
+#'
+#' @param connection                A connection object
+#' @param resultsDatabaseSchema     The fully qualified database name of the results schema
+#' @param cdmDatabaseSchema         The fully qualified database name of the CDM schema
+#' @param writeTableName            Name of DQD results table in the database to read from
+#' @param outputFolder              The folder to output the json results file to
+#' @param outputFile                The output filename of the json results file
+#'
+#' @export
+#'
+
+writeDBResultsToJson <- function(connection,
+                                 resultsDatabaseSchema,
+                                 cdmDatabaseSchema,
+                                 writeTableName,
+                                 outputFolder,
+                                 outputFile) {
+  metadata <- DatabaseConnector::renderTranslateQuerySql(
+    connection,
+    sql = "select * from @cdmDatabaseSchema.cdm_source;",
+    snakeCaseToCamelCase = TRUE,
+    cdmDatabaseSchema = cdmDatabaseSchema
+  )
+
+  checkResults <- DatabaseConnector::renderTranslateQuerySql(
+    connection,
+    sql = "select * from @resultsDatabaseSchema.@writeTableName;",
+    snakeCaseToCamelCase = TRUE,
+    resultsDatabaseSchema = resultsDatabaseSchema,
+    writeTableName = writeTableName
+  )
+
+  # Quick patch for missing value issues related to SQL Only Implementation
+  checkResults["error"][checkResults["error"] == ""] <- NA
+  checkResults["warning"][checkResults["warning"] == ""] <- NA
+  checkResults["executionTime"][checkResults["executionTime"] == ""] <- "0 secs"
+  checkResults["queryText"][checkResults["queryText"] == ""] <- "[Generated via SQL Only]"
+
+  overview <- .summarizeResults(
+    checkResults = checkResults
+  )
+
+  # Quick patch for non-camel-case column name
+  names(checkResults)[names(checkResults) == "checkid"] <- "checkId"
+
+  allResults <- list(
+    startTimestamp = Sys.time(),
+    endTimestamp = Sys.time(),
+    executionTime = "0 secs",
+    CheckResults = checkResults,
+    Metadata = metadata,
+    Overview = overview
+  )
+
+  .writeResultsToJson(
+    allResults,
+    outputFolder,
+    outputFile
+  )
+}

R/writeJsonResultsTo.R

@@ -47,7 +47,7 @@ writeJsonResultsToTable <- function(connectionDetails,
 
   ParallelLogger::logInfo(sprintf("Writing results to table %s", tableName))
 
-  if ("unitConceptId" %in% colnames(df)) {
+  if ("conceptId" %in% colnames(df)) {
     ddl <- SqlRender::loadRenderTranslateSql(
       sqlFilename = "result_table_ddl_concept.sql",
       packageName = "DataQualityDashboard",

_pkgdown.yml

@@ -63,3 +63,7 @@ reference:
     desc: > 
       Function to convert the case of a results JSON file between snakecase and camelcase
     contents: convertJsonResultsFileCase
+  - title: "Write database results to a JSON file"
+    desc: > 
+      Function to write DQD results from a database table into a JSON file
+    contents: writeDBResultsToJson