v5

Author: vojtechhuser

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: DataQuality
 Title: Data Quality study in OHDSI and data quality evaluation
-Version: 4.1
+Version: 5.0
 Authors@R: "Vojtech Huser <vojtech.huser@nih.gov> [aut, cre]"
 Description: This package has several functions. It supports Data Quality Dashboard and OHDSI Data Quality study. 
     It also allows Data Quality evaluation (even after closure of the formal study). 

NAMESPACE

@@ -5,7 +5,9 @@ export(.createConnectionDetails2)
 export(checkThemis)
 export(createMIAD)
 export(customMeasure)
+export(customMeasureSql)
 export(dashboardLabThresholds)
+export(dashboardLabValueAsConceptID)
 export(doTree)
 export(executeDQ)
 export(packageResults)

R/StudySpecific.R

@@ -613,3 +613,127 @@ dashboardLabThresholds <- function(connectionDetails,
   class(result) <- "connectionDetails2"
   return(result)
 }
+
+
+
+#' Execute all components of the DataQuality study (resultsDatabaseSchema is where Achilles results are)
+#' @param connectionDetails connection
+#' @param connectionDetails2 more study parameters
+#' @param runViaAchilles flag that runs legacy analysis using Achilles measure (analysis)
+#' @param exportThreshold removes rows that have fewer than specified events (default is 11)
+
+#' @export
+dashboardLabValueAsConceptID <- function(connectionDetails,
+                                   connectionDetails2,runViaAchilles=FALSE,exportThreshold=11
+){
+  
+  
+  #create export folder
+  #create export subfolder in workFolder
+  exportFolder <- file.path(connectionDetails2$workFolder, "export")
+  if (!file.exists(exportFolder))
+    dir.create(exportFolder)
+  
+  
+  #add readme file
+  #file.copy(system.file("dqd/readme.txt",package="DataQuality"), exportFolder)
+  #multiple steps here exporting to export folder
+  
+  #disabled for now
+  #if (runViaAchilles) {
+  if (FALSE) {
+    
+    writeLines("----Running some Achilles Measures")
+    Achilles::achilles(connectionDetails = connectionDetails
+                       ,cdmDatabaseSchema = connectionDetails2$cdmDatabaseSchema
+                       ,resultsDatabaseSchema = connectionDetails2$resultsDatabaseSchema
+                       ,cdmVersion = connectionDetails2$cdmVersion
+                       ,analysisIds = c(1807,1815) #,1816,1817)
+                       ,runHeel = FALSE
+                       ,createIndices = FALSE
+                       ,verboseMode = TRUE)
+    units<-Achilles::fetchAchillesAnalysisResults(connectionDetails = connectionDetails,resultsDatabaseSchema = connectionDetails2$resultsDatabaseSchema
+                                                  ,analysisId = 1807)
+    
+    units2<-units$analysisResults
+    names(units2) <- tolower(names(units2))
+    #names(units2)
+    #take those that have both defined
+    #str(units2)
+    units2$measurement_concept_id <-as.integer(units2$measurement_concept_id)
+    units2$unit_concept_id <-as.integer(units2$unit_concept_id)
+    #units, must have few numbers and non zero units
+    
+    
+    #more numbers
+    a<-.fetchAchillesAnalysisDistResults(connectionDetails = connectionDetails,resultsDatabaseSchema = connectionDetails2$resultsDatabaseSchema
+                                         #                  ,AnalysesAsSqlInCode = "1815,1816,1817")
+                                         ,AnalysesAsSqlInCode = "1815")
+    
+    
+    
+    
+    selected<-units2 %>% dplyr::filter( count_value>100 & unit_concept_id !=0 )
+    writeLines(paste("-----count of suitable measurements for analysis:",nrow(selected)))
+    
+    # write.csv(selected,file = file.path(exportFolder,'SuitableMeasurementsAndUnits.csv'),row.names = F)
+    # write.csv(a,file = file.path(exportFolder,'ThresholdsA.csv'),row.names = F)
+  }
+  
+  #execution via custom SQL (not to have dependency on Achilles)
+  #-- 1822	Number of measurement records, by measurement_concept_id and value_as_concept_id
+  sql='
+select
+	1822 AS analysis_id,
+	measurement_concept_id,
+	value_as_concept_id,
+	count_big(*) AS count_value
+from @cdmDatabaseSchema.measurement
+group by measurement_concept_id, value_as_concept_id;
+  '
+  b<-customMeasureSql(connectionDetails = connectionDetails,connectionDetails2 = connectionDetails2,sql=sql)
+  names(b) <- tolower(names(b))
+  b<-dplyr::filter(b, count_value>=exportThreshold)
+  
+  #convert values to percentages possibly here
+  options(scipen=999) #disable scientific notation
+  b2<-b %>% dplyr::group_by(measurement_concept_id) %>%  dplyr::mutate(perc= count_value / sum(count_value)) %>% 
+    dplyr::arrange(measurement_concept_id,desc(perc) ) %>% select(-count_value)
+  
+  
+  
+  writeLines(paste("-----count of measurements with coded value:",nrow(b)))
+  
+  writeLines(paste("--writing output file LabCodedValuesResults to export folder:",exportFolder))
+  
+  
+  write.csv(b2,file = file.path(exportFolder,'LabCodedValueResults.csv'),row.names = F)
+  
+  #final cleanup
+  writeLines("--Done with dashboardLabValueAsConceptID")
+  
+}
+
+
+#' do a custom measure
+#' @param connectionDetails connection
+#' @param connectionDetails2 more study parameters
+#' @param sql sql code to run
+
+#' @export
+customMeasureSql <- function(connectionDetails,
+                          connectionDetails2,
+                          sql){
+   
+	
+	 sql <- SqlRender::render(sql,cdmDatabaseSchema=connectionDetails2$cdmDatabaseSchema)
+	 #cat(sql)
+	 sql <- SqlRender::translate(sql,targetDialect = connectionDetails$dbms)
+	 
+	 conn <- DatabaseConnector::connect(connectionDetails)
+	 data <- DatabaseConnector::querySql(conn, sql)
+	 #View(data)
+	 
+	 DatabaseConnector::dbDisconnect(conn)
+	 return(data)
+}  

README.md

@@ -5,10 +5,20 @@ This is an R package that has sume utilities and also supports  informatics stud
 
 # Support development of Data Quality Dashboard (DQD)
 
-Package has functions that support addition of more rules and knowledge base items to the Data Quality Dashboard. For example, we want to compute 3rd and 97th percentile (or other parameters) for some lab results to use those as thresholds.
+Package has functions that support addition of more rules and knowledge base items to the Data Quality Dashboard. For example, we want to compute 3rd and 97th percentile (or other parameters) for some lab results to use those as thresholds. We also analyze what value_as_concept_ids are used with specific measurement_concept_ids to help OHDSI network to standardize value_as_concept_id for critical measurements.
 
 A site can participate on developing knowledbe base for DQD. Or it can take part on format research study (to be published). Se [extras/protocol](extras/protocol) folder for protocol. 
 
 To run the study, see DQD section in file [extras/CodeToRun.R](extras/CodeToRun.R)
 
 
+# Versions
+
+## v4.1
+Simplified release for DQD purpose of the package  
+
+
+## v5.0
+Addition of functionality to analyze value_as_concept_ids  
+
+

extras/CentralProcessingDQDThresholds.R

@@ -41,8 +41,11 @@ llmoded<-map(ll,~{names(.x)<-tolower(names(.x));return(.x)})
 ll2<-map2(llmoded,basename(sfiles),~mutate(.x,site=.y))
 d<-bind_rows(ll2)
 
+
+#---end of reading input files
+
 #add terminology concepts
-sconcept<-concept %>% select(concept_id,concept_name)
+sconcept<-concept %>% select(concept_id,concept_name,concept_code)
 names(d) <- tolower(names(d))
 names(d)
 #remove no units rows and expand the CIDs
@@ -52,8 +55,8 @@ names(d)
 
 
 d2<-d %>% filter(count_value >=11 ) %>% filter(stratum1_id != 0) %>% filter(stratum2_id != 0) %>% 
-  left_join(sconcept,by=c('stratum1_id'='concept_id')) %>%
-  left_join(sconcept,by=c('stratum2_id'='concept_id')) %>% filter(!is.na(concept_name.x))
+  left_join(concept %>% select(concept_id,concept_name,concept_code),by=c('stratum1_id'='concept_id')) %>%
+  left_join(concept %>% select(concept_id,concept_name),by=c('stratum2_id'='concept_id')) %>% filter(!is.na(concept_name.x))
 #test in 2B range are excluded by last filter
 
 names(d2)
@@ -66,7 +69,7 @@ soverview
 
 
 
-ba<-d2 %>% group_by(stratum1_id,stratum2_id,concept_name.x,concept_name.y) %>% summarize(tcnt=sum(count_value),n=n())
+ba<-d2 %>% group_by(stratum1_id,stratum2_id,concept_name.x,concept_name.y,concept_code) %>% summarize(tcnt=sum(count_value),n=n())
 ba %>% filter(n>=2) %>% nrow()
 nrow(ba)
 #4465 distinct test-unit pairs
@@ -179,7 +182,8 @@ viewSites
 #bc<-ddriven %>% inner_join(bset)
 #3009542 hematocrit
 options(scipen=999) #disable scientific notation
-prekb<-ddriven %>% group_by(conceptId,concept_name.x,unitConceptId,concept_name.y) %>% summarize(
+names(ddriven)
+prekb<-ddriven %>% group_by(conceptId,concept_name.x,unitConceptId,concept_name.y,concept_code) %>% summarize(
   n=n()
   ,sum_count_value=sum(count_value)
   #,kb_min_mean=mean(min_value)

extras/CodeToRun.R

@@ -47,8 +47,11 @@ connectionDetails2<-DataQuality:::.createConnectionDetails2(cdmDatabaseSchema =
 
 DataQuality::dashboardLabThresholds(connectionDetails = connectionDetails,connectionDetails2 = connectionDetails2)
 
+#second component added in May 2020
+DataQuality::dashboardLabValueAsConceptID(connectionDetails = connectionDetails,connectionDetails2 = connectionDetails2)
+
 #results are in workfolder, subfolder export, inspect it and 
-#email the CSV file called Thresholds to the study PI
+#email the CSV files called Thresholds and LabCodedValueResults to the study PI
 
 #for simplicity, the package is not using submission of the results via OHDSI AWS infrustructure 
 #(if requested by site, the code can be provided, though)