refactoring

OHDSI · May 13, 2024 · 4586a77 · 4586a77
1 parent a75e984
commit 4586a77
Show file tree

Hide file tree

Showing 2 changed files with 42 additions and 35 deletions.
diff --git a/R/calculateNotApplicableStatus.R b/R/calculateNotApplicableStatus.R
@@ -33,18 +33,48 @@
   naCheckNames <- c("cdmTable", "cdmField", "measureValueCompleteness")
   missingNAChecks <- !(naCheckNames %in% checkNames)
   if (any(missingNAChecks)) {
-    missingNACheckNames <- paste(naCheckNames[missingNAChecks], collapse = ", ")
     return(FALSE)
   }
   return(TRUE)
 }
 
+#' Applies the 'Not Applicable' status to a single check
+#'
+#' @param x Results from a single check
+#'
+#' @keywords internal
+.applyNotApplicable <- function(x) {
+  # Errors precede all other statuses
+  if (x$isError == 1) {
+    return(0)
+  }
+
+  # No NA status for cdmTable and cdmField if missing
+  if (x$checkName == "cdmTable" || x$checkName == "cdmField") {
+    return(0)
+  }
+
+  if (any(x$tableIsMissing, x$fieldIsMissing, x$tableIsEmpty, na.rm = TRUE)) {
+    return(1)
+  }
+
+  # No NA status for measureValueCompleteness if empty
+  if (x$checkName == "measureValueCompleteness") {
+    return(0)
+  }
+
+  if (any(x$fieldIsEmpty, x$conceptIsMissing, x$conceptAndUnitAreMissing, na.rm = TRUE)) {
+    return(1)
+  }
+
+  return(0)
+}
+
 #' Determines if check should be notApplicable and the notApplicableReason
 #'
 #' @param checkResults A dataframe containing the results of the data quality checks
 #'
 #' @keywords internal
-
 .calculateNotApplicableStatus <- function(checkResults) {
   # Look up missing tables and add variable tableIsMissing to checkResults
   missingTables <- checkResults %>%
@@ -81,7 +111,7 @@
     ) %>%
     dplyr::distinct()
 
-  # Look up empty fields and add variable tableIsEmpty to checkResults
+  # Look up empty fields and add variable fieldIsEmpty to checkResults
   emptyFields <- checkResults %>%
     dplyr::filter(
       .data$checkName == "measureValueCompleteness"
@@ -148,7 +178,7 @@
           .data$tableIsEmpty ~ sprintf("Table %s is empty.", .data$cdmTableName),
           .data$fieldIsEmpty ~ sprintf("Field %s.%s is not populated.", .data$cdmTableName, .data$cdmFieldName),
           .data$conceptIsMissing ~ sprintf("%s=%s is missing from the %s table.", .data$cdmFieldName, .data$conceptId, .data$cdmTableName),
-          .data$conceptAndUnitAreMissing ~ sprintf("Combination of %s=%s, unitConceptId=%s and VALUE_AS_NUMBER IS NOT NULL is missing from the %s table.", .data$cdmFieldName, .data$conceptId, .data$unitConceptId, .data$cdmTableName)
+          .data$conceptAndUnitAreMissing ~ sprintf("Combination of %s=%s, unitConceptId=%s and VALUE_AS_NUMBER IS NOT NULL is missing from the %s table.", .data$cdmFieldName, .data$conceptId, .data$unitConceptId, .data$cdmTableName) #nolint
         ),
         NA
       ),
@@ -159,30 +189,3 @@
 
   return(checkResults)
 }
-
-.applyNotApplicable <- function(x) {
-  # Errors precede all other statuses
-  if (x$isError == 1) {
-    return(0)
-  }
-
-  # No NA status for cdmTable and cdmField if missing
-  if (x$checkName == "cdmTable" || x$checkName == "cdmField") {
-    return(0)
-  }
-
-  if (any(x$tableIsMissing, x$fieldIsMissing, x$tableIsEmpty, na.rm = TRUE)) {
-    return(1)
-  }
-
-  # No NA status for measureValueCompleteness if empty
-  if (x$checkName == "measureValueCompleteness") {
-    return(0)
-  }
-
-  if (any(x$fieldIsEmpty, x$conceptIsMissing, x$conceptAndUnitAreMissing, na.rm = TRUE)) {
-    return(1)
-  }
-
-  return(0)
-}
diff --git a/tests/testthat/test-calculateNotApplicableStatus.R b/tests/testthat/test-calculateNotApplicableStatus.R
@@ -4,6 +4,11 @@ test_that("Not Applicable status Table Empty", {
   outputFolder <- tempfile("dqd_")
   on.exit(unlink(outputFolder, recursive = TRUE))
 
+  # Make sure the device exposure table is empty
+  connection <- DatabaseConnector::connect(connectionDetailsEunomia)
+  DatabaseConnector::executeSql(connection, "DELETE FROM DEVICE_EXPOSURE;")
+  DatabaseConnector::disconnect(connection)
+
   results <- executeDqChecks(
     connectionDetails = connectionDetailsEunomia,
     cdmDatabaseSchema = cdmDatabaseSchemaEunomia,
@@ -13,10 +18,9 @@ test_that("Not Applicable status Table Empty", {
     # Eunomia COST table has misspelled 'REVEUE_CODE_SOURCE_VALUE'
     tablesToExclude = c("COST", "CONCEPT", "VOCABULARY", "CONCEPT_ANCESTOR", "CONCEPT_RELATIONSHIP", "CONCEPT_CLASS", "CONCEPT_SYNONYM", "RELATIONSHIP", "DOMAIN"),
     outputFolder = outputFolder,
-    writeToTable = F
+    writeToTable = FALSE
   )
 
-  # Assumption that Eunomia has empty device_exposure table
   r <- results$CheckResults[results$CheckResults$checkName == "measureValueCompleteness" &
                             results$CheckResults$tableName == "device_exposure", ]
   expect_true(all(r$notApplicable == 1))
@@ -41,7 +45,7 @@ test_that("measureConditionEraCompleteness Not Applicable if condition_occurrenc
     # Eunomia COST table has misspelled 'REVEUE_CODE_SOURCE_VALUE'
     tablesToExclude = c("COST", "CONCEPT", "VOCABULARY", "CONCEPT_ANCESTOR", "CONCEPT_RELATIONSHIP", "CONCEPT_CLASS", "CONCEPT_SYNONYM", "RELATIONSHIP", "DOMAIN"),
     outputFolder = outputFolder,
-    writeToTable = F
+    writeToTable = FALSE
   )
 
   # Reinstate Condition Occurrence
@@ -73,7 +77,7 @@ test_that("measureConditionEraCompleteness Fails if condition_era empty", {
     # Eunomia COST table has misspelled 'REVEUE_CODE_SOURCE_VALUE'
     tablesToExclude = c("COST", "CONCEPT", "VOCABULARY", "CONCEPT_ANCESTOR", "CONCEPT_RELATIONSHIP", "CONCEPT_CLASS", "CONCEPT_SYNONYM", "RELATIONSHIP", "DOMAIN"),
     outputFolder = outputFolder,
-    writeToTable = F
+    writeToTable = FALSE
   )
 
   # Reinstate the Condition Era