From 7580ca9f278f21726217bb0a5e5275c633b776af Mon Sep 17 00:00:00 2001 From: jduke99 Date: Wed, 27 Aug 2014 00:18:24 -0400 Subject: [PATCH 1/7] Update README.md --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 44afb537..375bd075 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ Getting Started 1. Make sure you have your data in the [OMOP CDM v4 format](http://omop.org/cdm). -2. Make sure that you have Java installed. If you don't have Java already intalled on your computed (on most computers it already is installed), go to [java.com](http://java.com) to get the latest version. +2. Make sure that you have Java installed. If you don't have Java already intalled on your computed (on most computers it already is installed), go to [java.com](http://java.com) to get the latest version. (If you have trouble building with rJava below, be sure on Windows that your Path variable includes the path to jvm.dll (Windows Button --> type "path" --> Edit Environmental Variables --> Edit PATH variable, add to end ;C:/Program Files/Java/jre/bin/server) or wherever it is on your system.) 3. If you're using Windows, make sure you install [RTools](http://cran.r-project.org/bin/windows/Rtools/). From c777789ab6ff10f0723b3b3193d2c70d49041dc1 Mon Sep 17 00:00:00 2001 From: schuemie Date: Mon, 1 Sep 2014 09:09:42 -0400 Subject: [PATCH 2/7] Removed functions that are now in SqlRender and DatabaseConnector. Fixed analysis 211 for very large databases --- NAMESPACE | 1 - R/Achilles.R | 105 +----------------------- R/exportToJson.R | 136 +++++++++++++++---------------- inst/sql/sql_server/Achilles.sql | 36 ++++---- 4 files changed, 90 insertions(+), 188 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index be339a47..d7f55941 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -17,5 +17,4 @@ export(exportToJson) export(exportVisitToJson) export(fetchAchillesAnalysisResults) export(fetchAchillesHeelResults) -export(renderAndTranslate) export(showReportTypes) diff --git a/R/Achilles.R b/R/Achilles.R index 709c2339..b7fd1073 100644 --- a/R/Achilles.R +++ b/R/Achilles.R @@ -20,109 +20,6 @@ # @author Martijn Schuemie # @author Patrick Ryan -executeSql <- function(conn, dbms, sql){ - sqlStatements = splitSql(sql) - progressBar <- txtProgressBar(style=3) - start <- Sys.time() - for (i in 1:length(sqlStatements)){ - sqlStatement <- sqlStatements[i] - #sink(paste("c:/temp/statement_",i,".sql",sep="")) - #cat(sqlStatement) - #sink() - tryCatch ({ - #startQuery <- Sys.time() - - #Horrible hack for Redshift, which doesn't support DROP TABLE IF EXIST (or anything similar): - if (dbms == "redshift" & grepl("DROP TABLE IF EXISTS",sqlStatement)){ - nameStart = regexpr("DROP TABLE IF EXISTS", sqlStatement) + nchar("DROP TABLE IF EXISTS") + 1 - tableName = tolower(gsub("(^ +)|( +$)", "", substr(sqlStatement,nameStart,nchar(sqlStatement)))) - tableCount = dbGetQuery(conn,paste("SELECT COUNT(*) FROM pg_table_def WHERE tablename = '",tableName,"'",sep="")) - if (tableCount != 0) - dbSendUpdate(conn, paste("DROP TABLE",tableName)) - } else - dbSendUpdate(conn, sqlStatement) - #delta <- Sys.time() - startQuery - #writeLines(paste("Statement ",i,"took", delta, attr(delta,"units"))) - } , error = function(err) { - writeLines(paste("Error executing SQL:",err)) - - #Write error report: - filename <- paste(getwd(),"/errorReport.txt",sep="") - sink(filename) - error <<- err - cat("DBMS:\n") - cat(dbms) - cat("\n\n") - cat("Error:\n") - cat(err$message) - cat("\n\n") - cat("SQL:\n") - cat(sqlStatement) - sink() - - writeLines(paste("An error report has been created at ", filename)) - break - }) - setTxtProgressBar(progressBar, i/length(sqlStatements)) - } - close(progressBar) - delta <- Sys.time() - start - writeLines(paste("Analysis took", signif(delta,3), attr(delta,"units"))) -} - -querySql <- function(conn, dbms, sql){ - tryCatch ({ - .jcall("java/lang/System",,"gc") #Calling garbage collection prevents crashes - - if (dbms == "postgresql" | dbms == "redshift"){ #Use dbGetQueryBatchWise to prevent Java out of heap - result <- dbGetQueryBatchWise(conn, sql) - colnames(result) <- toupper(colnames(result)) - return(result) - } else { - result <- dbGetQuery(conn, sql) - colnames(result) <- toupper(colnames(result)) - return(result) - } - - } , error = function(err) { - writeLines(paste("Error executing SQL:",err)) - - #Write error report: - filename <- paste(getwd(),"/errorReport.txt",sep="") - sink(filename) - error <<- err - cat("DBMS:\n") - cat(dbms) - cat("\n\n") - cat("Error:\n") - cat(err$message) - cat("\n\n") - cat("SQL:\n") - cat(sql) - sink() - - writeLines(paste("An error report has been created at ", filename)) - break - }) -} - -#' @export -renderAndTranslate <- function(sqlFilename, packageName, dbms, ...){ - pathToSql <- system.file(paste("sql/",gsub(" ","_",dbms),sep=""), sqlFilename, package=packageName) - mustTranslate <- !file.exists(pathToSql) - if (mustTranslate) # If DBMS-specific code does not exists, load SQL Server code and translate after rendering - pathToSql <- system.file(paste("sql/","sql_server",sep=""), sqlFilename, package=packageName) - parameterizedSql <- readChar(pathToSql,file.info(pathToSql)$size) - - renderedSql <- renderSql(parameterizedSql[1], ...)$sql - - if (mustTranslate) - renderedSql <- translateSql(renderedSql, "sql server", dbms)$sql - - renderedSql -} - - #' The main Achilles analysis #' #' @description @@ -155,7 +52,7 @@ achilles <- function (connectionDetails, cdmSchema, resultsSchema, sourceName = if (missing(resultsSchema)) resultsSchema <- cdmSchema - renderedSql <- renderAndTranslate(sqlFilename = "Achilles.sql", + renderedSql <- loadRenderTranslateSql(sqlFilename = "Achilles.sql", packageName = "Achilles", dbms = connectionDetails$dbms, CDM_schema = cdmSchema, diff --git a/R/exportToJson.R b/R/exportToJson.R index 452f1502..d797dd6c 100644 --- a/R/exportToJson.R +++ b/R/exportToJson.R @@ -503,7 +503,7 @@ generateAchillesHeelReport <- function(conn, dbms, cdmSchema, outputPath) { writeLines("Generating achilles heel report") output <- {} - queryAchillesHeel <- renderAndTranslate(sqlFilename = "export/achillesheel/sqlAchillesHeel.sql", + queryAchillesHeel <- loadRenderTranslateSql (sqlFilename = "export/achillesheel/sqlAchillesHeel.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -519,7 +519,7 @@ generateDrugEraTreemap <- function(conn, dbms,cdmSchema, outputPath) { progressBar <- txtProgressBar(max=1,style=3) progress = 0 - queryDrugEraTreemap <- renderAndTranslate(sqlFilename = "export/drugera/sqlDrugEraTreemap.sql", + queryDrugEraTreemap <- loadRenderTranslateSql (sqlFilename = "export/drugera/sqlDrugEraTreemap.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -539,7 +539,7 @@ generateDrugTreemap <- function(conn, dbms,cdmSchema, outputPath) { progressBar <- txtProgressBar(max=1,style=3) progress = 0 - queryDrugTreemap <- renderAndTranslate(sqlFilename = "export/drug/sqlDrugTreemap.sql", + queryDrugTreemap <- loadRenderTranslateSql (sqlFilename = "export/drug/sqlDrugTreemap.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -559,7 +559,7 @@ generateConditionTreemap <- function(conn, dbms, cdmSchema, outputPath) { progressBar <- txtProgressBar(max=1,style=3) progress = 0 - queryConditionTreemap <- renderAndTranslate(sqlFilename = "export/condition/sqlConditionTreemap.sql", + queryConditionTreemap <- loadRenderTranslateSql (sqlFilename = "export/condition/sqlConditionTreemap.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -579,7 +579,7 @@ generateConditionEraTreemap <- function(conn, dbms, cdmSchema, outputPath) { progressBar <- txtProgressBar(max=1,style=3) progress = 0 - queryConditionEraTreemap <- renderAndTranslate(sqlFilename = "export/conditionera/sqlConditionEraTreemap.sql", + queryConditionEraTreemap <- loadRenderTranslateSql (sqlFilename = "export/conditionera/sqlConditionEraTreemap.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -619,25 +619,25 @@ generateConditionReports <- function(conn, dbms, cdmSchema, outputPath) { progressBar <- txtProgressBar(style=3) progress = 0 - queryPrevalenceByGenderAgeYear <- renderAndTranslate(sqlFilename = "export/condition/sqlPrevalenceByGenderAgeYear.sql", + queryPrevalenceByGenderAgeYear <- loadRenderTranslateSql (sqlFilename = "export/condition/sqlPrevalenceByGenderAgeYear.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryPrevalenceByMonth <- renderAndTranslate(sqlFilename = "export/condition/sqlPrevalenceByMonth.sql", + queryPrevalenceByMonth <- loadRenderTranslateSql (sqlFilename = "export/condition/sqlPrevalenceByMonth.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryConditionsByType <- renderAndTranslate(sqlFilename = "export/condition/sqlConditionsByType.sql", + queryConditionsByType <- loadRenderTranslateSql (sqlFilename = "export/condition/sqlConditionsByType.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryAgeAtFirstDiagnosis <- renderAndTranslate(sqlFilename = "export/condition/sqlAgeAtFirstDiagnosis.sql", + queryAgeAtFirstDiagnosis <- loadRenderTranslateSql (sqlFilename = "export/condition/sqlAgeAtFirstDiagnosis.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -696,25 +696,25 @@ generateConditionEraReports <- function(conn, dbms, cdmSchema, outputPath) { progressBar <- txtProgressBar(style=3) progress = 0 - queryPrevalenceByGenderAgeYear <- renderAndTranslate(sqlFilename = "export/conditionera/sqlPrevalenceByGenderAgeYear.sql", + queryPrevalenceByGenderAgeYear <- loadRenderTranslateSql (sqlFilename = "export/conditionera/sqlPrevalenceByGenderAgeYear.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryPrevalenceByMonth <- renderAndTranslate(sqlFilename = "export/conditionera/sqlPrevalenceByMonth.sql", + queryPrevalenceByMonth <- loadRenderTranslateSql (sqlFilename = "export/conditionera/sqlPrevalenceByMonth.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryAgeAtFirstDiagnosis <- renderAndTranslate(sqlFilename = "export/conditionera/sqlAgeAtFirstDiagnosis.sql", + queryAgeAtFirstDiagnosis <- loadRenderTranslateSql (sqlFilename = "export/conditionera/sqlAgeAtFirstDiagnosis.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryLengthOfEra <- renderAndTranslate(sqlFilename = "export/conditionera/sqlLengthOfEra.sql", + queryLengthOfEra <- loadRenderTranslateSql (sqlFilename = "export/conditionera/sqlLengthOfEra.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -774,25 +774,25 @@ generateDrugEraReports <- function(conn, dbms, cdmSchema, outputPath) { progressBar <- txtProgressBar(style=3) progress = 0 - queryAgeAtFirstExposure <- renderAndTranslate(sqlFilename = "export/drugera/sqlAgeAtFirstExposure.sql", + queryAgeAtFirstExposure <- loadRenderTranslateSql (sqlFilename = "export/drugera/sqlAgeAtFirstExposure.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryPrevalenceByGenderAgeYear <- renderAndTranslate(sqlFilename = "export/drugera/sqlPrevalenceByGenderAgeYear.sql", + queryPrevalenceByGenderAgeYear <- loadRenderTranslateSql (sqlFilename = "export/drugera/sqlPrevalenceByGenderAgeYear.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryPrevalenceByMonth <- renderAndTranslate(sqlFilename = "export/drugera/sqlPrevalenceByMonth.sql", + queryPrevalenceByMonth <- loadRenderTranslateSql (sqlFilename = "export/drugera/sqlPrevalenceByMonth.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryLengthOfEra <- renderAndTranslate(sqlFilename = "export/drugera/sqlLengthOfEra.sql", + queryLengthOfEra <- loadRenderTranslateSql (sqlFilename = "export/drugera/sqlLengthOfEra.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -850,43 +850,43 @@ generateDrugReports <- function(conn, dbms, cdmSchema, outputPath) { progressBar <- txtProgressBar(style=3) progress = 0 - queryAgeAtFirstExposure <- renderAndTranslate(sqlFilename = "export/drug/sqlAgeAtFirstExposure.sql", + queryAgeAtFirstExposure <- loadRenderTranslateSql (sqlFilename = "export/drug/sqlAgeAtFirstExposure.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryDaysSupplyDistribution <- renderAndTranslate(sqlFilename = "export/drug/sqlDaysSupplyDistribution.sql", + queryDaysSupplyDistribution <- loadRenderTranslateSql (sqlFilename = "export/drug/sqlDaysSupplyDistribution.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryDrugsByType <- renderAndTranslate(sqlFilename = "export/drug/sqlDrugsByType.sql", + queryDrugsByType <- loadRenderTranslateSql (sqlFilename = "export/drug/sqlDrugsByType.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryPrevalenceByGenderAgeYear <- renderAndTranslate(sqlFilename = "export/drug/sqlPrevalenceByGenderAgeYear.sql", + queryPrevalenceByGenderAgeYear <- loadRenderTranslateSql (sqlFilename = "export/drug/sqlPrevalenceByGenderAgeYear.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryPrevalenceByMonth <- renderAndTranslate(sqlFilename = "export/drug/sqlPrevalenceByMonth.sql", + queryPrevalenceByMonth <- loadRenderTranslateSql (sqlFilename = "export/drug/sqlPrevalenceByMonth.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryQuantityDistribution <- renderAndTranslate(sqlFilename = "export/drug/sqlQuantityDistribution.sql", + queryQuantityDistribution <- loadRenderTranslateSql (sqlFilename = "export/drug/sqlQuantityDistribution.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryRefillsDistribution <- renderAndTranslate(sqlFilename = "export/drug/sqlRefillsDistribution.sql", + queryRefillsDistribution <- loadRenderTranslateSql (sqlFilename = "export/drug/sqlRefillsDistribution.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -932,7 +932,7 @@ generateProcedureTreemap <- function(conn, dbms, cdmSchema, outputPath) { progressBar <- txtProgressBar(max=1,style=3) progress = 0 - queryProcedureTreemap <- renderAndTranslate(sqlFilename = "export/procedure/sqlProcedureTreemap.sql", + queryProcedureTreemap <- loadRenderTranslateSql (sqlFilename = "export/procedure/sqlProcedureTreemap.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -971,25 +971,25 @@ generateProcedureReports <- function(conn, dbms, cdmSchema, outputPath) { progressBar <- txtProgressBar(style=3) progress = 0 - queryPrevalenceByGenderAgeYear <- renderAndTranslate(sqlFilename = "export/procedure/sqlPrevalenceByGenderAgeYear.sql", + queryPrevalenceByGenderAgeYear <- loadRenderTranslateSql (sqlFilename = "export/procedure/sqlPrevalenceByGenderAgeYear.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryPrevalenceByMonth <- renderAndTranslate(sqlFilename = "export/procedure/sqlPrevalenceByMonth.sql", + queryPrevalenceByMonth <- loadRenderTranslateSql (sqlFilename = "export/procedure/sqlPrevalenceByMonth.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryProceduresByType <- renderAndTranslate(sqlFilename = "export/procedure/sqlProceduresByType.sql", + queryProceduresByType <- loadRenderTranslateSql (sqlFilename = "export/procedure/sqlProceduresByType.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryAgeAtFirstOccurrence <- renderAndTranslate(sqlFilename = "export/procedure/sqlAgeAtFirstOccurrence.sql", + queryAgeAtFirstOccurrence <- loadRenderTranslateSql (sqlFilename = "export/procedure/sqlAgeAtFirstOccurrence.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1036,7 +1036,7 @@ generatePersonReport <- function(conn, dbms, cdmSchema, outputPath) # b. Row #1: CDM source name # c. Row #2: # of persons - renderedSql <- renderAndTranslate(sqlFilename = "export/person/population.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/person/population.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1052,7 +1052,7 @@ generatePersonReport <- function(conn, dbms, cdmSchema, outputPath) # a. Visualization: Pie # b. Category: Gender # c. Value: % of persons - renderedSql <- renderAndTranslate(sqlFilename = "export/person/gender.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/person/gender.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1067,7 +1067,7 @@ generatePersonReport <- function(conn, dbms, cdmSchema, outputPath) # a. Visualization: Pie # b. Category: Race # c. Value: % of persons - renderedSql <- renderAndTranslate(sqlFilename = "export/person/race.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/person/race.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1082,7 +1082,7 @@ generatePersonReport <- function(conn, dbms, cdmSchema, outputPath) # a. Visualization: Pie # b. Category: Ethnicity # c. Value: % of persons - renderedSql <- renderAndTranslate(sqlFilename = "export/person/ethnicity.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/person/ethnicity.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1099,7 +1099,7 @@ generatePersonReport <- function(conn, dbms, cdmSchema, outputPath) # c. Value: # of persons birthYearHist <- {} - renderedSql <- renderAndTranslate(sqlFilename = "export/person/yearofbirth_stats.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/person/yearofbirth_stats.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1113,7 +1113,7 @@ generatePersonReport <- function(conn, dbms, cdmSchema, outputPath) birthYearHist$INTERVAL_SIZE = birthYearStats$INTERVAL_SIZE birthYearHist$INTERVALS = (birthYearStats$MAX_VALUE - birthYearStats$MIN_VALUE) / birthYearStats$INTERVAL_SIZE - renderedSql <- renderAndTranslate(sqlFilename = "export/person/yearofbirth_data.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/person/yearofbirth_data.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1155,7 +1155,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) ageAtFirstObservationHist$INTERVAL_SIZE = 1 ageAtFirstObservationHist$INTERVALS = 100 - renderedSql <- renderAndTranslate(sqlFilename = "export/observationperiod/ageatfirst.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/observationperiod/ageatfirst.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1171,7 +1171,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) # b. Category: Gender # c. Values: Min/25%/Median/95%/Max - age at time of first observation - renderedSql <- renderAndTranslate(sqlFilename = "export/observationperiod/agebygender.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/observationperiod/agebygender.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1188,7 +1188,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) observationLengthHist <- {} - renderedSql <- renderAndTranslate(sqlFilename = "export/observationperiod/observationlength_stats.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/observationperiod/observationlength_stats.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1202,7 +1202,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) observationLengthHist$INTERVAL_SIZE = observationLengthStats$INTERVAL_SIZE observationLengthHist$INTERVALS = (observationLengthStats$MAX_VALUE - observationLengthStats$MIN_VALUE) / observationLengthStats$INTERVAL_SIZE - renderedSql <- renderAndTranslate(sqlFilename = "export/observationperiod/observationlength_data.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/observationperiod/observationlength_data.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1221,7 +1221,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) # c. Y-axis: % of population observed # d. Note: will look like a Kaplan-Meier ‘survival’ plot, but information is the same as shown in ‘length of observation’ barchart, just plotted as cumulative - renderedSql <- renderAndTranslate(sqlFilename = "export/observationperiod/cumulativeduration.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/observationperiod/cumulativeduration.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1237,7 +1237,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) # b. Category: Gender # c. Values: Min/25%/Median/95%/Max length of observation period - renderedSql <- renderAndTranslate(sqlFilename = "export/observationperiod/observationlengthbygender.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/observationperiod/observationlengthbygender.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1252,7 +1252,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) # b. Category: Age decile # c. Values: Min/25%/Median/95%/Max length of observation period - renderedSql <- renderAndTranslate(sqlFilename = "export/observationperiod/observationlengthbyage.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/observationperiod/observationlengthbyage.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1268,7 +1268,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) # c. Values: # of persons with continuous coverage observedByYearHist <- {} - renderedSql <- renderAndTranslate(sqlFilename = "export/observationperiod/observedbyyear_stats.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/observationperiod/observedbyyear_stats.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1281,7 +1281,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) observedByYearHist$INTERVAL_SIZE = observedByYearStats$INTERVAL_SIZE observedByYearHist$INTERVALS = (observedByYearStats$MAX_VALUE - observedByYearStats$MIN_VALUE) / observedByYearStats$INTERVAL_SIZE - renderedSql <- renderAndTranslate(sqlFilename = "export/observationperiod/observedbyyear_data.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/observationperiod/observedbyyear_data.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1301,7 +1301,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) observedByMonth <- {} - renderedSql <- renderAndTranslate(sqlFilename = "export/observationperiod/observedbymonth.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/observationperiod/observedbymonth.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1317,7 +1317,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) # b. Category: Number of observation periods # c. Values: # of persons - renderedSql <- renderAndTranslate(sqlFilename = "export/observationperiod/periodsperperson.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/observationperiod/periodsperperson.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1381,7 +1381,7 @@ generateDataDensityReport <- function(conn, dbms,cdmSchema, outputPath) # c. y-axis: records # d. series: person, visit, condition, drug, procedure, observation - renderedSql <- renderAndTranslate(sqlFilename = "export/datadensity/totalrecords.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/datadensity/totalrecords.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1398,7 +1398,7 @@ generateDataDensityReport <- function(conn, dbms,cdmSchema, outputPath) # c. y-axis: records/person # d. series: person, visit, condition, drug, procedure, observation - renderedSql <- renderAndTranslate(sqlFilename = "export/datadensity/recordsperperson.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/datadensity/recordsperperson.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1414,7 +1414,7 @@ generateDataDensityReport <- function(conn, dbms,cdmSchema, outputPath) # b. Category: Condition/Drug/Procedure/Observation # c. Values: Min/25%/Median/95%/Max number of distinct concepts per person - renderedSql <- renderAndTranslate(sqlFilename = "export/datadensity/conceptsperperson.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/datadensity/conceptsperperson.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1437,7 +1437,7 @@ generateObservationTreemap <- function(conn, dbms, cdmSchema, outputPath) { progressBar <- txtProgressBar(max=1,style=3) progress = 0 - queryObservationTreemap <- renderAndTranslate(sqlFilename = "export/observation/sqlObservationTreemap.sql", + queryObservationTreemap <- loadRenderTranslateSql (sqlFilename = "export/observation/sqlObservationTreemap.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1478,55 +1478,55 @@ generateObservationReports <- function(conn, dbms, cdmSchema, outputPath) progressBar <- txtProgressBar(style=3) progress = 0 - queryPrevalenceByGenderAgeYear <- renderAndTranslate(sqlFilename = "export/observation/sqlPrevalenceByGenderAgeYear.sql", + queryPrevalenceByGenderAgeYear <- loadRenderTranslateSql (sqlFilename = "export/observation/sqlPrevalenceByGenderAgeYear.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryPrevalenceByMonth <- renderAndTranslate(sqlFilename = "export/observation/sqlPrevalenceByMonth.sql", + queryPrevalenceByMonth <- loadRenderTranslateSql (sqlFilename = "export/observation/sqlPrevalenceByMonth.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryObservationsByType <- renderAndTranslate(sqlFilename = "export/observation/sqlObservationsByType.sql", + queryObservationsByType <- loadRenderTranslateSql (sqlFilename = "export/observation/sqlObservationsByType.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryAgeAtFirstOccurrence <- renderAndTranslate(sqlFilename = "export/observation/sqlAgeAtFirstOccurrence.sql", + queryAgeAtFirstOccurrence <- loadRenderTranslateSql (sqlFilename = "export/observation/sqlAgeAtFirstOccurrence.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryRecordsByUnit <- renderAndTranslate(sqlFilename = "export/observation/sqlRecordsByUnit.sql", + queryRecordsByUnit <- loadRenderTranslateSql (sqlFilename = "export/observation/sqlRecordsByUnit.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryObservationValueDistribution <- renderAndTranslate(sqlFilename = "export/observation/sqlObservationValueDistribution.sql", + queryObservationValueDistribution <- loadRenderTranslateSql (sqlFilename = "export/observation/sqlObservationValueDistribution.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryLowerLimitDistribution <- renderAndTranslate(sqlFilename = "export/observation/sqlLowerLimitDistribution.sql", + queryLowerLimitDistribution <- loadRenderTranslateSql (sqlFilename = "export/observation/sqlLowerLimitDistribution.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryUpperLimitDistribution <- renderAndTranslate(sqlFilename = "export/observation/sqlUpperLimitDistribution.sql", + queryUpperLimitDistribution <- loadRenderTranslateSql (sqlFilename = "export/observation/sqlUpperLimitDistribution.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryValuesRelativeToNorm <- renderAndTranslate(sqlFilename = "export/observation/sqlValuesRelativeToNorm.sql", + queryValuesRelativeToNorm <- loadRenderTranslateSql (sqlFilename = "export/observation/sqlValuesRelativeToNorm.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1578,7 +1578,7 @@ generateVisitTreemap <- function(conn, dbms, cdmSchema, outputPath){ progressBar <- txtProgressBar(max=1,style=3) progress = 0 - queryVisitTreemap <- renderAndTranslate(sqlFilename = "export/visit/sqlVisitTreemap.sql", + queryVisitTreemap <- loadRenderTranslateSql (sqlFilename = "export/visit/sqlVisitTreemap.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1617,25 +1617,25 @@ generateVisitReports <- function(conn, dbms, cdmSchema, outputPath){ progressBar <- txtProgressBar(style=3) progress = 0 - queryPrevalenceByGenderAgeYear <- renderAndTranslate(sqlFilename = "export/visit/sqlPrevalenceByGenderAgeYear.sql", + queryPrevalenceByGenderAgeYear <- loadRenderTranslateSql (sqlFilename = "export/visit/sqlPrevalenceByGenderAgeYear.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryPrevalenceByMonth <- renderAndTranslate(sqlFilename = "export/visit/sqlPrevalenceByMonth.sql", + queryPrevalenceByMonth <- loadRenderTranslateSql (sqlFilename = "export/visit/sqlPrevalenceByMonth.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryVisitDurationByType <- renderAndTranslate(sqlFilename = "export/visit/sqlVisitDurationByType.sql", + queryVisitDurationByType <- loadRenderTranslateSql (sqlFilename = "export/visit/sqlVisitDurationByType.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema ) - queryAgeAtFirstOccurrence <- renderAndTranslate(sqlFilename = "export/visit/sqlAgeAtFirstOccurrence.sql", + queryAgeAtFirstOccurrence <- loadRenderTranslateSql (sqlFilename = "export/visit/sqlAgeAtFirstOccurrence.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1682,7 +1682,7 @@ generateDeathReports <- function(conn, dbms, cdmSchema, outputPath){ # d. y-axis: condition prevalence (% persons) # e. series: male, female - renderedSql <- renderAndTranslate(sqlFilename = "export/death/sqlPrevalenceByGenderAgeYear.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/death/sqlPrevalenceByGenderAgeYear.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1699,7 +1699,7 @@ generateDeathReports <- function(conn, dbms, cdmSchema, outputPath){ # c. y-axis: % of persons # d. Comment: plot to show seasonality - renderedSql <- renderAndTranslate(sqlFilename = "export/death/sqlPrevalenceByMonth.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/death/sqlPrevalenceByMonth.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1715,7 +1715,7 @@ generateDeathReports <- function(conn, dbms, cdmSchema, outputPath){ # b. Category: death type # c. value: % of records - renderedSql <- renderAndTranslate(sqlFilename = "export/death/sqlDeathByType.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/death/sqlDeathByType.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema @@ -1731,7 +1731,7 @@ generateDeathReports <- function(conn, dbms, cdmSchema, outputPath){ # b. Category: gender # c. Values: Min/25%/Median/95%/Max as age at death - renderedSql <- renderAndTranslate(sqlFilename = "export/death/sqlAgeAtDeath.sql", + renderedSql <- loadRenderTranslateSql (sqlFilename = "export/death/sqlAgeAtDeath.sql", packageName = "Achilles", dbms = dbms, cdmSchema = cdmSchema diff --git a/inst/sql/sql_server/Achilles.sql b/inst/sql/sql_server/Achilles.sql index 390a370a..bbf3c45b 100644 --- a/inst/sql/sql_server/Achilles.sql +++ b/inst/sql/sql_server/Achilles.sql @@ -1467,23 +1467,29 @@ where vo1.care_site_id is not null -- 211 Distribution of length of stay by visit_concept_id insert into @results_schema.dbo.ACHILLES_results_dist (analysis_id, stratum_1, count_value, min_value, max_value, avg_value, stdev_value, median_value, p10_value, p25_value, p75_value, p90_value) select 211 as analysis_id, - place_of_service_concept_id as stratum_1, - COUNT_BIG(count_value) as count_value, - min(count_value) as min_value, - max(count_value) as max_value, - avg(1.0*count_value) as avg_value, - stdev(count_value) as stdev_value, - max(case when p1<=0.50 then count_value else -9999 end) as median_value, - max(case when p1<=0.10 then count_value else -9999 end) as p10_value, - max(case when p1<=0.25 then count_value else -9999 end) as p25_value, - max(case when p1<=0.75 then count_value else -9999 end) as p75_value, - max(case when p1<=0.90 then count_value else -9999 end) as p90_value + place_of_service_concept_id as stratum_1, + COUNT_BIG(count_value) as count_value, + min(count_value) as min_value, + max(count_value) as max_value, + avg(1.0*count_value) as avg_value, + stdev(count_value) as stdev_value, + max(case when p1<=0.50 then count_value else -9999 end) as median_value, + max(case when p1<=0.10 then count_value else -9999 end) as p10_value, + max(case when p1<=0.25 then count_value else -9999 end) as p25_value, + max(case when p1<=0.75 then count_value else -9999 end) as p75_value, + max(case when p1<=0.90 then count_value else -9999 end) as p90_value from ( -select vo1.place_of_service_concept_id, - datediff(dd,visit_start_date,visit_end_date) as count_value, - 1.0*(row_number() over (partition by vo1.place_of_service_concept_id order by datediff(dd,visit_start_date,visit_end_date)))/(COUNT_BIG(datediff(dd,visit_start_date,visit_end_date)) over (partition by vo1.place_of_service_concept_id)+1) as p1 -from visit_occurrence vo1 + select place_of_service_concept_id, count_value, (1.0 * (row_number() over (partition by place_of_service_concept_id order by count_value)) / (Q.total +1)) as p1 + from + ( + select vo1.place_of_service_concept_id, datediff(dd,visit_start_date,visit_end_date) as count_value, pc.total + from visit_occurrence vo1 + JOIN + ( + select place_of_service_concept_id, COUNT_BIG(*) as total from visit_occurrence group by PLACE_OF_SERVICE_CONCEPT_ID + ) pc on pc.PLACE_OF_SERVICE_CONCEPT_ID = vo1.PLACE_OF_SERVICE_CONCEPT_ID + ) Q ) t1 group by place_of_service_concept_id ; From 9c3e60c8835e134c2f9249c800b403b5bbfa5f73 Mon Sep 17 00:00:00 2001 From: schuemie Date: Sat, 6 Sep 2014 07:18:01 -0400 Subject: [PATCH 3/7] Removed dbms parameter in executeSql and querySql calls. --- R/Achilles.R | 2 +- R/exportToJson.R | 136 +++++++++++++++++++++++------------------------ 2 files changed, 69 insertions(+), 69 deletions(-) diff --git a/R/Achilles.R b/R/Achilles.R index b7fd1073..28ee4a78 100644 --- a/R/Achilles.R +++ b/R/Achilles.R @@ -66,7 +66,7 @@ achilles <- function (connectionDetails, cdmSchema, resultsSchema, sourceName = conn <- connect(connectionDetails) writeLines("Executing multiple queries. This could take a while") - executeSql(conn,connectionDetails$dbms,renderedSql) + executeSql(conn,renderedSql) writeLines(paste("Done. Results can now be found in",resultsSchema)) dummy <- dbDisconnect(conn) diff --git a/R/exportToJson.R b/R/exportToJson.R index d797dd6c..7bc4eed4 100644 --- a/R/exportToJson.R +++ b/R/exportToJson.R @@ -509,7 +509,7 @@ generateAchillesHeelReport <- function(conn, dbms, cdmSchema, outputPath) { cdmSchema = cdmSchema ) - output$MESSAGES <- querySql(conn,dbms,queryAchillesHeel) + output$MESSAGES <- querySql(conn,queryAchillesHeel) jsonOutput = toJSON(output) write(jsonOutput, file=paste(outputPath, "/achillesheel.json", sep="")) } @@ -525,7 +525,7 @@ generateDrugEraTreemap <- function(conn, dbms,cdmSchema, outputPath) { cdmSchema = cdmSchema ) - dataDrugEraTreemap <- querySql(conn,dbms,queryDrugEraTreemap) + dataDrugEraTreemap <- querySql(conn,queryDrugEraTreemap) write(toJSON(dataDrugEraTreemap,method="C"),paste(outputPath, "/drugera_treemap.json", sep='')) progress = progress + 1 @@ -545,7 +545,7 @@ generateDrugTreemap <- function(conn, dbms,cdmSchema, outputPath) { cdmSchema = cdmSchema ) - dataDrugTreemap <- querySql(conn,dbms,queryDrugTreemap) + dataDrugTreemap <- querySql(conn,queryDrugTreemap) write(toJSON(dataDrugTreemap,method="C"),paste(outputPath, "/drug_treemap.json", sep='')) progress = progress + 1 @@ -565,7 +565,7 @@ generateConditionTreemap <- function(conn, dbms, cdmSchema, outputPath) { cdmSchema = cdmSchema ) - dataConditionTreemap <- querySql(conn,dbms,queryConditionTreemap) + dataConditionTreemap <- querySql(conn,queryConditionTreemap) write(toJSON(dataConditionTreemap,method="C"),paste(outputPath, "/condition_treemap.json", sep='')) progress = progress + 1 @@ -585,7 +585,7 @@ generateConditionEraTreemap <- function(conn, dbms, cdmSchema, outputPath) { cdmSchema = cdmSchema ) - dataConditionEraTreemap <- querySql(conn,dbms,queryConditionEraTreemap) + dataConditionEraTreemap <- querySql(conn,queryConditionEraTreemap) write(toJSON(dataConditionEraTreemap,method="C"),paste(outputPath, "/conditionera_treemap.json", sep='')) progress = progress + 1 @@ -643,10 +643,10 @@ generateConditionReports <- function(conn, dbms, cdmSchema, outputPath) { cdmSchema = cdmSchema ) - dataPrevalenceByGenderAgeYear <- querySql(conn,dbms,queryPrevalenceByGenderAgeYear) - dataPrevalenceByMonth <- querySql(conn,dbms,queryPrevalenceByMonth) - dataConditionsByType <- querySql(conn,dbms,queryConditionsByType) - dataAgeAtFirstDiagnosis <- querySql(conn,dbms,queryAgeAtFirstDiagnosis) + dataPrevalenceByGenderAgeYear <- querySql(conn,queryPrevalenceByGenderAgeYear) + dataPrevalenceByMonth <- querySql(conn,queryPrevalenceByMonth) + dataConditionsByType <- querySql(conn,queryConditionsByType) + dataAgeAtFirstDiagnosis <- querySql(conn,queryAgeAtFirstDiagnosis) buildConditionReport <- function(concept_id) { @@ -720,10 +720,10 @@ generateConditionEraReports <- function(conn, dbms, cdmSchema, outputPath) { cdmSchema = cdmSchema ) - dataPrevalenceByGenderAgeYear <- querySql(conn,dbms,queryPrevalenceByGenderAgeYear) - dataPrevalenceByMonth <- querySql(conn,dbms,queryPrevalenceByMonth) - dataLengthOfEra <- querySql(conn,dbms,queryLengthOfEra) - dataAgeAtFirstDiagnosis <- querySql(conn,dbms,queryAgeAtFirstDiagnosis) + dataPrevalenceByGenderAgeYear <- querySql(conn,queryPrevalenceByGenderAgeYear) + dataPrevalenceByMonth <- querySql(conn,queryPrevalenceByMonth) + dataLengthOfEra <- querySql(conn,queryLengthOfEra) + dataAgeAtFirstDiagnosis <- querySql(conn,queryAgeAtFirstDiagnosis) buildConditionEraReport <- function(concept_id) { @@ -798,10 +798,10 @@ generateDrugEraReports <- function(conn, dbms, cdmSchema, outputPath) { cdmSchema = cdmSchema ) - dataAgeAtFirstExposure <- querySql(conn,dbms,queryAgeAtFirstExposure) - dataPrevalenceByGenderAgeYear <- querySql(conn,dbms,queryPrevalenceByGenderAgeYear) - dataPrevalenceByMonth <- querySql(conn,dbms,queryPrevalenceByMonth) - dataLengthOfEra <- querySql(conn,dbms,queryLengthOfEra) + dataAgeAtFirstExposure <- querySql(conn,queryAgeAtFirstExposure) + dataPrevalenceByGenderAgeYear <- querySql(conn,queryPrevalenceByGenderAgeYear) + dataPrevalenceByMonth <- querySql(conn,queryPrevalenceByMonth) + dataLengthOfEra <- querySql(conn,queryLengthOfEra) buildDrugEraReport <- function(concept_id) { report <- {} @@ -892,13 +892,13 @@ generateDrugReports <- function(conn, dbms, cdmSchema, outputPath) { cdmSchema = cdmSchema ) - dataAgeAtFirstExposure <- querySql(conn,dbms,queryAgeAtFirstExposure) - dataDaysSupplyDistribution <- querySql(conn,dbms,queryDaysSupplyDistribution) - dataDrugsByType <- querySql(conn,dbms,queryDrugsByType) - dataPrevalenceByGenderAgeYear <- querySql(conn,dbms,queryPrevalenceByGenderAgeYear) - dataPrevalenceByMonth <- querySql(conn,dbms,queryPrevalenceByMonth) - dataQuantityDistribution <- querySql(conn,dbms,queryQuantityDistribution) - dataRefillsDistribution <- querySql(conn,dbms,queryRefillsDistribution) + dataAgeAtFirstExposure <- querySql(conn,queryAgeAtFirstExposure) + dataDaysSupplyDistribution <- querySql(conn,queryDaysSupplyDistribution) + dataDrugsByType <- querySql(conn,queryDrugsByType) + dataPrevalenceByGenderAgeYear <- querySql(conn,queryPrevalenceByGenderAgeYear) + dataPrevalenceByMonth <- querySql(conn,queryPrevalenceByMonth) + dataQuantityDistribution <- querySql(conn,queryQuantityDistribution) + dataRefillsDistribution <- querySql(conn,queryRefillsDistribution) buildDrugReport <- function(concept_id) { report <- {} @@ -938,7 +938,7 @@ generateProcedureTreemap <- function(conn, dbms, cdmSchema, outputPath) { cdmSchema = cdmSchema ) - dataProcedureTreemap <- querySql(conn,dbms,queryProcedureTreemap) + dataProcedureTreemap <- querySql(conn,queryProcedureTreemap) write(toJSON(dataProcedureTreemap,method="C"),paste(outputPath, "/procedure_treemap.json", sep='')) progress = progress + 1 @@ -995,10 +995,10 @@ generateProcedureReports <- function(conn, dbms, cdmSchema, outputPath) { cdmSchema = cdmSchema ) - dataPrevalenceByGenderAgeYear <- querySql(conn,dbms,queryPrevalenceByGenderAgeYear) - dataPrevalenceByMonth <- querySql(conn,dbms,queryPrevalenceByMonth) - dataProceduresByType <- querySql(conn,dbms,queryProceduresByType) - dataAgeAtFirstOccurrence <- querySql(conn,dbms,queryAgeAtFirstOccurrence) + dataPrevalenceByGenderAgeYear <- querySql(conn,queryPrevalenceByGenderAgeYear) + dataPrevalenceByMonth <- querySql(conn,queryPrevalenceByMonth) + dataProceduresByType <- querySql(conn,queryProceduresByType) + dataAgeAtFirstOccurrence <- querySql(conn,queryAgeAtFirstOccurrence) buildProcedureReport <- function(concept_id) { report <- {} @@ -1042,7 +1042,7 @@ generatePersonReport <- function(conn, dbms, cdmSchema, outputPath) cdmSchema = cdmSchema ) - personSummaryData <- querySql(conn,dbms,renderedSql) + personSummaryData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) @@ -1057,7 +1057,7 @@ generatePersonReport <- function(conn, dbms, cdmSchema, outputPath) dbms = dbms, cdmSchema = cdmSchema ) - genderData <- querySql(conn,dbms,renderedSql) + genderData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) @@ -1072,7 +1072,7 @@ generatePersonReport <- function(conn, dbms, cdmSchema, outputPath) dbms = dbms, cdmSchema = cdmSchema ) - raceData <- querySql(conn,dbms,renderedSql) + raceData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) @@ -1087,7 +1087,7 @@ generatePersonReport <- function(conn, dbms, cdmSchema, outputPath) dbms = dbms, cdmSchema = cdmSchema ) - ethnicityData <- querySql(conn,dbms,renderedSql) + ethnicityData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) @@ -1104,7 +1104,7 @@ generatePersonReport <- function(conn, dbms, cdmSchema, outputPath) dbms = dbms, cdmSchema = cdmSchema ) - birthYearStats <- querySql(conn,dbms,renderedSql) + birthYearStats <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) @@ -1118,7 +1118,7 @@ generatePersonReport <- function(conn, dbms, cdmSchema, outputPath) dbms = dbms, cdmSchema = cdmSchema ) - birthYearData <- querySql(conn,dbms,renderedSql) + birthYearData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) @@ -1160,7 +1160,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) dbms = dbms, cdmSchema = cdmSchema ) - ageAtFirstObservationData <- querySql(conn,dbms,renderedSql) + ageAtFirstObservationData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) ageAtFirstObservationHist$DATA = ageAtFirstObservationData @@ -1176,7 +1176,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) dbms = dbms, cdmSchema = cdmSchema ) - ageByGenderData <- querySql(conn,dbms,renderedSql) + ageByGenderData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) output$AGE_BY_GENDER = ageByGenderData @@ -1194,7 +1194,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) cdmSchema = cdmSchema ) - observationLengthStats <- querySql(conn,dbms,renderedSql) + observationLengthStats <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) observationLengthHist$MIN = observationLengthStats$MIN_VALUE @@ -1207,7 +1207,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) dbms = dbms, cdmSchema = cdmSchema ) - observationLengthData <- querySql(conn,dbms,renderedSql) + observationLengthData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) observationLengthHist$DATA <- observationLengthData @@ -1227,7 +1227,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) cdmSchema = cdmSchema ) - cumulativeDurationData <- querySql(conn,dbms,renderedSql) + cumulativeDurationData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) output$CUMULATIVE_DURATION = cumulativeDurationData @@ -1242,7 +1242,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) dbms = dbms, cdmSchema = cdmSchema ) - opLengthByGenderData <- querySql(conn,dbms,renderedSql) + opLengthByGenderData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) output$OBSERVATION_PERIOD_LENGTH_BY_GENDER = opLengthByGenderData @@ -1257,7 +1257,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) dbms = dbms, cdmSchema = cdmSchema ) - opLengthByAgeData <- querySql(conn,dbms,renderedSql) + opLengthByAgeData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) output$OBSERVATION_PERIOD_LENGTH_BY_AGE = opLengthByAgeData @@ -1273,7 +1273,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) dbms = dbms, cdmSchema = cdmSchema ) - observedByYearStats <- querySql(conn,dbms,renderedSql) + observedByYearStats <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) observedByYearHist$MIN = observedByYearStats$MIN_VALUE @@ -1287,7 +1287,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) cdmSchema = cdmSchema ) - observedByYearData <- querySql(conn,dbms,renderedSql) + observedByYearData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) observedByYearHist$DATA <- observedByYearData @@ -1306,7 +1306,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) dbms = dbms, cdmSchema = cdmSchema ) - observedByMonth <- querySql(conn,dbms,renderedSql) + observedByMonth <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) @@ -1322,7 +1322,7 @@ generateObservationPeriodReport <- function(conn, dbms, cdmSchema, outputPath) dbms = dbms, cdmSchema = cdmSchema ) - personPeriodsData <- querySql(conn,dbms,renderedSql) + personPeriodsData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) output$PERSON_PERIODS_DATA = personPeriodsData @@ -1387,7 +1387,7 @@ generateDataDensityReport <- function(conn, dbms,cdmSchema, outputPath) cdmSchema = cdmSchema ) - totalRecordsData <- querySql(conn,dbms,renderedSql) + totalRecordsData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) output$TOTAL_RECORDS = totalRecordsData @@ -1404,7 +1404,7 @@ generateDataDensityReport <- function(conn, dbms,cdmSchema, outputPath) cdmSchema = cdmSchema ) - recordsPerPerson <- querySql(conn,dbms,renderedSql) + recordsPerPerson <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) output$RECORDS_PER_PERSON = recordsPerPerson @@ -1420,7 +1420,7 @@ generateDataDensityReport <- function(conn, dbms,cdmSchema, outputPath) cdmSchema = cdmSchema ) - conceptsPerPerson <- querySql(conn,dbms,renderedSql) + conceptsPerPerson <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) output$CONCEPTS_PER_PERSON = conceptsPerPerson @@ -1443,7 +1443,7 @@ generateObservationTreemap <- function(conn, dbms, cdmSchema, outputPath) { cdmSchema = cdmSchema ) - dataObservationTreemap <- querySql(conn,dbms,queryObservationTreemap) + dataObservationTreemap <- querySql(conn,queryObservationTreemap) write(toJSON(dataObservationTreemap,method="C"),paste(outputPath, "/observation_treemap.json", sep='')) progress = progress + 1 @@ -1532,15 +1532,15 @@ generateObservationReports <- function(conn, dbms, cdmSchema, outputPath) cdmSchema = cdmSchema ) - dataPrevalenceByGenderAgeYear <- querySql(conn,dbms,queryPrevalenceByGenderAgeYear) - dataPrevalenceByMonth <- querySql(conn,dbms,queryPrevalenceByMonth) - dataObservationsByType <- querySql(conn,dbms,queryObservationsByType) - dataAgeAtFirstOccurrence <- querySql(conn,dbms,queryAgeAtFirstOccurrence) - dataRecordsByUnit <- querySql(conn,dbms,queryRecordsByUnit) - dataObservationValueDistribution <- querySql(conn,dbms,queryObservationValueDistribution) - dataLowerLimitDistribution <- querySql(conn,dbms,queryLowerLimitDistribution) - dataUpperLimitDistribution <- querySql(conn,dbms,queryUpperLimitDistribution) - dataValuesRelativeToNorm <- querySql(conn,dbms,queryValuesRelativeToNorm) + dataPrevalenceByGenderAgeYear <- querySql(conn,queryPrevalenceByGenderAgeYear) + dataPrevalenceByMonth <- querySql(conn,queryPrevalenceByMonth) + dataObservationsByType <- querySql(conn,queryObservationsByType) + dataAgeAtFirstOccurrence <- querySql(conn,queryAgeAtFirstOccurrence) + dataRecordsByUnit <- querySql(conn,queryRecordsByUnit) + dataObservationValueDistribution <- querySql(conn,queryObservationValueDistribution) + dataLowerLimitDistribution <- querySql(conn,queryLowerLimitDistribution) + dataUpperLimitDistribution <- querySql(conn,queryUpperLimitDistribution) + dataValuesRelativeToNorm <- querySql(conn,queryValuesRelativeToNorm) buildObservationReport <- function(concept_id) { report <- {} @@ -1584,7 +1584,7 @@ generateVisitTreemap <- function(conn, dbms, cdmSchema, outputPath){ cdmSchema = cdmSchema ) - dataVisitTreemap <- querySql(conn,dbms,queryVisitTreemap) + dataVisitTreemap <- querySql(conn,queryVisitTreemap) write(toJSON(dataVisitTreemap,method="C"),paste(outputPath, "/visit_treemap.json", sep='')) progress = progress + 1 @@ -1641,10 +1641,10 @@ generateVisitReports <- function(conn, dbms, cdmSchema, outputPath){ cdmSchema = cdmSchema ) - dataPrevalenceByGenderAgeYear <- querySql(conn,dbms,queryPrevalenceByGenderAgeYear) - dataPrevalenceByMonth <- querySql(conn,dbms,queryPrevalenceByMonth) - dataVisitDurationByType <- querySql(conn,dbms,queryVisitDurationByType) - dataAgeAtFirstOccurrence <- querySql(conn,dbms,queryAgeAtFirstOccurrence) + dataPrevalenceByGenderAgeYear <- querySql(conn,queryPrevalenceByGenderAgeYear) + dataPrevalenceByMonth <- querySql(conn,queryPrevalenceByMonth) + dataVisitDurationByType <- querySql(conn,queryVisitDurationByType) + dataAgeAtFirstOccurrence <- querySql(conn,queryAgeAtFirstOccurrence) buildVisitReport <- function(concept_id) { report <- {} @@ -1688,7 +1688,7 @@ generateDeathReports <- function(conn, dbms, cdmSchema, outputPath){ cdmSchema = cdmSchema ) - prevalenceByGenderAgeYearData <- querySql(conn,dbms,renderedSql) + prevalenceByGenderAgeYearData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) output$PREVALENCE_BY_GENDER_AGE_YEAR = prevalenceByGenderAgeYearData @@ -1705,7 +1705,7 @@ generateDeathReports <- function(conn, dbms, cdmSchema, outputPath){ cdmSchema = cdmSchema ) - prevalenceByMonthData <- querySql(conn,dbms,renderedSql) + prevalenceByMonthData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) output$PREVALENCE_BY_MONTH = prevalenceByMonthData @@ -1721,7 +1721,7 @@ generateDeathReports <- function(conn, dbms, cdmSchema, outputPath){ cdmSchema = cdmSchema ) - deathByTypeData <- querySql(conn,dbms,renderedSql) + deathByTypeData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) output$DEATH_BY_TYPE = deathByTypeData @@ -1737,7 +1737,7 @@ generateDeathReports <- function(conn, dbms, cdmSchema, outputPath){ cdmSchema = cdmSchema ) - ageAtDeathData <- querySql(conn,dbms,renderedSql) + ageAtDeathData <- querySql(conn,renderedSql) progress = progress + 1 setTxtProgressBar(progressBar, progress) output$AGE_AT_DEATH = ageAtDeathData From f1d4b51b7b3767992dd7698010718c25a904986f Mon Sep 17 00:00:00 2001 From: schuemie Date: Sun, 7 Sep 2014 11:25:11 -0400 Subject: [PATCH 4/7] Fixed bug for condition_era treemap on Sql Server. --- R/TestAchillesCode.R | 2 +- R/TestExportCode.R | 2 +- .../export/condition/sqlConditionTreemap.sql | 209 +++++++++--------- .../conditionera/sqlConditionEraTreemap.sql | 6 +- 4 files changed, 110 insertions(+), 109 deletions(-) diff --git a/R/TestAchillesCode.R b/R/TestAchillesCode.R index e205020b..d16360ec 100644 --- a/R/TestAchillesCode.R +++ b/R/TestAchillesCode.R @@ -30,7 +30,7 @@ testAchillesCode <- function(){ #Test on Oracle using sample: setwd("c:/temp") - connectionDetailsOracle <- createConnectionDetails(dbms="oracle", server="xe", user="system",password=pw) + connectionDetailsOracle <- createConnectionDetails(dbms="oracle", server="xe", user="system",password="OHDSI") achillesResultsOracle <- achilles(connectionDetailsOracle, cdmSchema="cdm4_sim", resultsSchema="scratch") #achillesResultsOracle <- achilles(connectionDetailsOracle, cdmSchema="cdm4_sim", resultsSchema="scratch", analysisIds=c(116),createTable=FALSE) diff --git a/R/TestExportCode.R b/R/TestExportCode.R index f12cce43..6adad073 100644 --- a/R/TestExportCode.R +++ b/R/TestExportCode.R @@ -24,7 +24,7 @@ testExportCode <- function(){ #Test on Oracle sample setwd("c:/temp") - connectionDetails <- createConnectionDetails(dbms="oracle", server="xe", user="system",password=pw) + connectionDetails <- createConnectionDetails(dbms="oracle", server="xe", user="system",password="OHDSI") exportToJson(connectionDetails, cdmSchema = "cdm4_sim", resultsSchema = "scratch",outputPath = "c:/temp/Oracle") #exportToJson(connectionDetails, cdmSchema = "cdm4_sim", resultsSchema = "scratch",outputPath = "c:/temp/Oracle", report = c("CONDITION_ERA")) diff --git a/inst/sql/sql_server/export/condition/sqlConditionTreemap.sql b/inst/sql/sql_server/export/condition/sqlConditionTreemap.sql index f7d5c84a..696ab5e9 100644 --- a/inst/sql/sql_server/export/condition/sqlConditionTreemap.sql +++ b/inst/sql/sql_server/export/condition/sqlConditionTreemap.sql @@ -1,104 +1,105 @@ -select concept_hierarchy.concept_id, - isNull(concept_hierarchy.soc_concept_name,'NA') + '||' + isNull(concept_hierarchy.hlgt_concept_name,'NA') + '||' + isNull(concept_hierarchy.hlt_concept_name,'NA') + '||' + isNull(concept_hierarchy.pt_concept_name,'NA') + '||' + isNull(concept_hierarchy.snomed_concept_name,'NA') concept_path, ar1.count_value as num_persons, - round(1.0*ar1.count_value / denom.count_value,5) as percent_persons, - round(1.0*ar2.count_value / ar1.count_value,5) as records_per_person -from (select * from ACHILLES_results where analysis_id = 400) ar1 - inner join - (select * from ACHILLES_results where analysis_id = 401) ar2 - on ar1.stratum_1 = ar2.stratum_1 - inner join - ( - select snomed.concept_id, - snomed.concept_name as snomed_concept_name, - pt_to_hlt.pt_concept_name, - hlt_to_hlgt.hlt_concept_name, - hlgt_to_soc.hlgt_concept_name, - soc.concept_name as soc_concept_name - from - ( - select concept_id, concept_name - from @cdmSchema.dbo.concept - where vocabulary_id = 1 - ) snomed - left join - (select c1.concept_id as snomed_concept_id, max(c2.concept_id) as pt_concept_id - from - @cdmSchema.dbo.concept c1 - inner join - @cdmSchema.dbo.concept_ancestor ca1 - on c1.concept_id = ca1.descendant_concept_id - and c1.vocabulary_id = 1 - inner join - @cdmSchema.dbo.concept c2 - on ca1.ancestor_concept_id = c2.concept_id - and c2.vocabulary_id = 15 - and c2.concept_class = 'Preferred Term' - group by c1.concept_id - ) snomed_to_pt - on snomed.concept_id = snomed_to_pt.snomed_concept_id - - left join - (select c1.concept_id as pt_concept_id, c1.concept_name as pt_concept_name, max(c2.concept_id) as hlt_concept_id - from - @cdmSchema.dbo.concept c1 - inner join - @cdmSchema.dbo.concept_ancestor ca1 - on c1.concept_id = ca1.descendant_concept_id - and c1.vocabulary_id = 15 - and c1.concept_class = 'Preferred Term' - inner join - @cdmSchema.dbo.concept c2 - on ca1.ancestor_concept_id = c2.concept_id - and c2.vocabulary_id = 15 - and c2.concept_class = 'High Level Term' - group by c1.concept_id, c1.concept_name - ) pt_to_hlt - on snomed_to_pt.pt_concept_id = pt_to_hlt.pt_concept_id - - left join - (select c1.concept_id as hlt_concept_id, c1.concept_name as hlt_concept_name, max(c2.concept_id) as hlgt_concept_id - from - @cdmSchema.dbo.concept c1 - inner join - @cdmSchema.dbo.concept_ancestor ca1 - on c1.concept_id = ca1.descendant_concept_id - and c1.vocabulary_id = 15 - and c1.concept_class = 'High Level Term' - inner join - @cdmSchema.dbo.concept c2 - on ca1.ancestor_concept_id = c2.concept_id - and c2.vocabulary_id = 15 - and c2.concept_class = 'High Level Group Term' - group by c1.concept_id, c1.concept_name - ) hlt_to_hlgt - on pt_to_hlt.hlt_concept_id = hlt_to_hlgt.hlt_concept_id - - left join - (select c1.concept_id as hlgt_concept_id, c1.concept_name as hlgt_concept_name, max(c2.concept_id) as soc_concept_id - from - @cdmSchema.dbo.concept c1 - inner join - @cdmSchema.dbo.concept_ancestor ca1 - on c1.concept_id = ca1.descendant_concept_id - and c1.vocabulary_id = 15 - and c1.concept_class = 'High Level Group Term' - inner join - @cdmSchema.dbo.concept c2 - on ca1.ancestor_concept_id = c2.concept_id - and c2.vocabulary_id = 15 - and c2.concept_class = 'System Organ Class' - group by c1.concept_id, c1.concept_name - ) hlgt_to_soc - on hlt_to_hlgt.hlgt_concept_id = hlgt_to_soc.hlgt_concept_id - - left join @cdmSchema.dbo.concept soc - on hlgt_to_soc.soc_concept_id = soc.concept_id - - - - ) concept_hierarchy - on CAST(ar1.stratum_1 AS INT) = concept_hierarchy.concept_id - , - (select count_value from ACHILLES_results where analysis_id = 1) denom - -order by ar1.count_value desc +select concept_hierarchy.concept_id, + isNull(concept_hierarchy.soc_concept_name,'NA') + '||' + isNull(concept_hierarchy.hlgt_concept_name,'NA') + '||' + isNull(concept_hierarchy.hlt_concept_name,'NA') + '||' + isNull(concept_hierarchy.pt_concept_name,'NA') + '||' + isNull(concept_hierarchy.snomed_concept_name,'NA') concept_path, + ar1.count_value as num_persons, + round(1.0*ar1.count_value / denom.count_value,5) as percent_persons, + round(1.0*ar2.count_value / ar1.count_value,5) as records_per_person +from (select * from ACHILLES_results where analysis_id = 400) ar1 + inner join + (select * from ACHILLES_results where analysis_id = 401) ar2 + on ar1.stratum_1 = ar2.stratum_1 + inner join + ( + select snomed.concept_id, + snomed.concept_name as snomed_concept_name, + pt_to_hlt.pt_concept_name, + hlt_to_hlgt.hlt_concept_name, + hlgt_to_soc.hlgt_concept_name, + soc.concept_name as soc_concept_name + from + ( + select concept_id, concept_name + from @cdmSchema.dbo.concept + where vocabulary_id = 1 + ) snomed + left join + (select c1.concept_id as snomed_concept_id, max(c2.concept_id) as pt_concept_id + from + @cdmSchema.dbo.concept c1 + inner join + @cdmSchema.dbo.concept_ancestor ca1 + on c1.concept_id = ca1.descendant_concept_id + and c1.vocabulary_id = 1 + inner join + @cdmSchema.dbo.concept c2 + on ca1.ancestor_concept_id = c2.concept_id + and c2.vocabulary_id = 15 + and c2.concept_class = 'Preferred Term' + group by c1.concept_id + ) snomed_to_pt + on snomed.concept_id = snomed_to_pt.snomed_concept_id + + left join + (select c1.concept_id as pt_concept_id, c1.concept_name as pt_concept_name, max(c2.concept_id) as hlt_concept_id + from + @cdmSchema.dbo.concept c1 + inner join + @cdmSchema.dbo.concept_ancestor ca1 + on c1.concept_id = ca1.descendant_concept_id + and c1.vocabulary_id = 15 + and c1.concept_class = 'Preferred Term' + inner join + @cdmSchema.dbo.concept c2 + on ca1.ancestor_concept_id = c2.concept_id + and c2.vocabulary_id = 15 + and c2.concept_class = 'High Level Term' + group by c1.concept_id, c1.concept_name + ) pt_to_hlt + on snomed_to_pt.pt_concept_id = pt_to_hlt.pt_concept_id + + left join + (select c1.concept_id as hlt_concept_id, c1.concept_name as hlt_concept_name, max(c2.concept_id) as hlgt_concept_id + from + @cdmSchema.dbo.concept c1 + inner join + @cdmSchema.dbo.concept_ancestor ca1 + on c1.concept_id = ca1.descendant_concept_id + and c1.vocabulary_id = 15 + and c1.concept_class = 'High Level Term' + inner join + @cdmSchema.dbo.concept c2 + on ca1.ancestor_concept_id = c2.concept_id + and c2.vocabulary_id = 15 + and c2.concept_class = 'High Level Group Term' + group by c1.concept_id, c1.concept_name + ) hlt_to_hlgt + on pt_to_hlt.hlt_concept_id = hlt_to_hlgt.hlt_concept_id + + left join + (select c1.concept_id as hlgt_concept_id, c1.concept_name as hlgt_concept_name, max(c2.concept_id) as soc_concept_id + from + @cdmSchema.dbo.concept c1 + inner join + @cdmSchema.dbo.concept_ancestor ca1 + on c1.concept_id = ca1.descendant_concept_id + and c1.vocabulary_id = 15 + and c1.concept_class = 'High Level Group Term' + inner join + @cdmSchema.dbo.concept c2 + on ca1.ancestor_concept_id = c2.concept_id + and c2.vocabulary_id = 15 + and c2.concept_class = 'System Organ Class' + group by c1.concept_id, c1.concept_name + ) hlgt_to_soc + on hlt_to_hlgt.hlgt_concept_id = hlgt_to_soc.hlgt_concept_id + + left join @cdmSchema.dbo.concept soc + on hlgt_to_soc.soc_concept_id = soc.concept_id + + + + ) concept_hierarchy + on CAST(ar1.stratum_1 AS INT) = concept_hierarchy.concept_id + , + (select count_value from ACHILLES_results where analysis_id = 1) denom + +order by ar1.count_value desc diff --git a/inst/sql/sql_server/export/conditionera/sqlConditionEraTreemap.sql b/inst/sql/sql_server/export/conditionera/sqlConditionEraTreemap.sql index 76dd8a3e..580815b4 100644 --- a/inst/sql/sql_server/export/conditionera/sqlConditionEraTreemap.sql +++ b/inst/sql/sql_server/export/conditionera/sqlConditionEraTreemap.sql @@ -1,8 +1,8 @@ select concept_hierarchy.concept_id, - isNull(concept_hierarchy.soc_concept_name,'NA') + '||' + isNull(concept_hierarchy.hlgt_concept_name,'NA') + '||' + isNull(concept_hierarchy.hlt_concept_name, 'NA') + '||' + isNull(concept_hierarchy.pt_concept_name,'NA') + '||' + isNull(concept_hierarchy.snomed_concept_name,'NA') concept_path, + isNull(concept_hierarchy.soc_concept_name,'NA') + '||' + isNull(concept_hierarchy.hlgt_concept_name,'NA') + '||' + isNull(concept_hierarchy.hlt_concept_name,'NA') + '||' + isNull(concept_hierarchy.pt_concept_name,'NA') + '||' + isNull(concept_hierarchy.snomed_concept_name,'NA') concept_path, ar1.count_value as num_persons, - ROUND(CAST(1.0*ar1.count_value / denom.count_value AS NUMERIC),5) as percent_persons, - ROUND(CAST(ar2.avg_value AS NUMERIC),5) as length_of_era + ROUND(1.0*ar1.count_value / denom.count_value,5) as percent_persons, + ROUND(ar2.avg_value,5) as length_of_era from (select * from ACHILLES_results where analysis_id = 1000) ar1 inner join (select stratum_1, avg_value from ACHILLES_results_dist where analysis_id = 1007) ar2 From 8aec280729a3c1c97a52010a1ef0da6b128ad0c8 Mon Sep 17 00:00:00 2001 From: schuemie Date: Fri, 12 Sep 2014 00:54:44 -0400 Subject: [PATCH 5/7] Improved tests --- R/TestAchillesCode.R | 97 ++++++++++++-------------------------------- 1 file changed, 26 insertions(+), 71 deletions(-) diff --git a/R/TestAchillesCode.R b/R/TestAchillesCode.R index d16360ec..8b6acf8c 100644 --- a/R/TestAchillesCode.R +++ b/R/TestAchillesCode.R @@ -1,7 +1,7 @@ # some test-code testAchillesCode <- function(){ - + pw <- "" #Test on SQL Server: @@ -10,12 +10,12 @@ testAchillesCode <- function(){ achillesResultsSqlServer <- achilles(connectionDetailsSqlServer, cdmSchema="cdm4_sim", resultsSchema="scratch") #achillesResultsSqlServer <- achilles(connectionDetailsSqlServer, cdmSchema="cdm4_sim", resultsSchema="scratch", analysisIds=c(606),createTable=FALSE) - + #Test on PostgreSQL setwd("c:/temp") connectionDetailsPostgreSql <- createConnectionDetails(dbms="postgresql", server="localhost/ohdsi", user="postgres",password=pw) achillesResultsPostgreSql <- achilles(connectionDetailsPostgreSql, cdmSchema="cdm4_sim", resultsSchema="scratch") - + #achillesResultsPostgreSql <- achilles(connectionDetailsPostgreSql, cdmSchema="cdm4_sim", resultsSchema="scratch",analysisIds=c(600:620),createTable = FALSE) #fetchAchillesAnalysisResults(connectionDetailsPostgreSql, "scratch", 606) @@ -56,12 +56,23 @@ testAchillesCode <- function(){ y[is.na(y)] <- "" } if (!(nrow(x) == 0 && nrow(y) == 0)){ + x <- round(signif(x[sapply(x,FUN=is.numeric)],5),5) + y <- round(signif(y[sapply(y,FUN=is.numeric)],5),5) if (nrow(x) != nrow(y)){ writeLines(paste("Difference detected for analysisId",analysis_id)) - } else if (min(round(signif(x[sapply(x,FUN=is.numeric)],5),5) == round(signif(y[sapply(y,FUN=is.numeric)],5),5)) == 0){ + } else if (min(x==y) == 0){ writeLines(paste("Difference detected for analysisId",analysis_id)) - #break - } + if (analysis_id %in% c(818)){ + writeLines("(This was expected)") + }else { + for (r in 1:nrow(x)){ + if (min(x[r,] == y[r,]) == 0){ + col <- which(x[r,] != y[r,]) + writeLines(paste("Difference in",colnames(x)[col],":",x[r,col],"versus",y[r,col])) + } + } + } + } } } @@ -81,11 +92,18 @@ testAchillesCode <- function(){ y[is.na(y)] <- "" } if (!(nrow(x) == 0 && nrow(y) == 0)){ + x <- round(signif(x[sapply(x,FUN=is.numeric)],5),5) + y <- round(signif(y[sapply(y,FUN=is.numeric)],5),5) if (nrow(x) != nrow(y)){ writeLines(paste("Difference detected for analysisId",analysis_id)) - } else if (min(round(signif(x[sapply(x,FUN=is.numeric)],5),5) == round(signif(y[sapply(y,FUN=is.numeric)],5),5)) == 0){ + } else if (min(x==y) == 0){ writeLines(paste("Difference detected for analysisId",analysis_id)) - #break + for (r in 1:nrow(x)){ + if (min(x[r,] == y[r,]) == 0){ + col <- which(x[r,] != y[r,]) + writeLines(paste("Difference in",colnames(x)[col],":",x[r,col],"versus",y[r,col])) + } + } } } } @@ -100,34 +118,6 @@ testAchillesCode <- function(){ compareResults(connSqlServer,connPostgreSql) - x1 <- fetchAchillesAnalysisResults(connectionDetailsSqlServer, resultsSchema = "scratch", analysisId = 1510) - x2 <- fetchAchillesAnalysisResults(connectionDetailsPostgreSql, resultsSchema = "scratch", analysisId = 1510) - - x1 <- dbGetQuery(connSqlServer,"SELECT * FROM achilles_results WHERE analysis_id = 1411") - x2 <- dbGetQuery(connPostgreSql,"SELECT * FROM achilles_results WHERE analysis_id = 1411") - colnames(x1) <- toupper(colnames(x1)) - x1 <- x1[with(x1,order(STRATUM_1,STRATUM_2,STRATUM_3,STRATUM_4,STRATUM_5)),] - colnames(x2) <- toupper(colnames(x2)) - x2 <- x2[with(x2,order(STRATUM_1,STRATUM_2,STRATUM_3,STRATUM_4,STRATUM_5)),] - head(x1) - head(x2) - xn1 <- round(signif(x1[sapply(x1,FUN=is.numeric)],3),3) - xn2 <- round(signif(x2[sapply(x2,FUN=is.numeric)],3),3) - sum(xn1 != xn2) - for (r in 1:nrow(xn1)){ - if (min(xn1[r,] == xn2[r,]) == 0){ - print(r) - } - } - - xn1[2904,] - xn2[2904,] - xn1[2382,] == xn2[2382,] - is.numeric(xn1[2095,5]) - is.numeric(xn2[2095,5]) - write.csv(x1,"c:/temp/x1.csv",row.names=FALSE) - write.csv(x2,"c:/temp/x2.csv",row.names=FALSE) - #Compare on sample set: connectionDetailsOracle$schema = "scratch" connOracle <- connect(connectionDetailsOracle) @@ -137,39 +127,4 @@ testAchillesCode <- function(){ compareResults(connOracle,connPostgreSql) - x1 <- dbGetQuery(connOracle,"SELECT * FROM achilles_results WHERE analysis_id = 1411") - x2 <- dbGetQuery(connPostgreSql,"SELECT * FROM achilles_results WHERE analysis_id = 1411") - colnames(x1) <- toupper(colnames(x1)) - x1 <- x1[with(x1,order(STRATUM_1,STRATUM_2,STRATUM_3,STRATUM_4,STRATUM_5)),] - colnames(x2) <- toupper(colnames(x2)) - x2 <- x2[with(x2,order(STRATUM_1,STRATUM_2,STRATUM_3,STRATUM_4,STRATUM_5)),] - head(x1) - head(x2) - xn1 <- round(signif(x1[sapply(x1,FUN=is.numeric)],3),3) - xn2 <- round(signif(x2[sapply(x2,FUN=is.numeric)],3),3) - sum(xn1 != xn2) - for (r in 1:nrow(xn1)){ - if (min(xn1[r,] == xn2[r,]) == 0){ - print(r) - } - } - - xn1[2904,] - xn2[2904,] - xn1[2382,] == xn2[2382,] - is.numeric(xn1[2095,5]) - is.numeric(xn2[2095,5]) - write.csv(x1,"c:/temp/x1.csv",row.names=FALSE) - write.csv(x2,"c:/temp/x2.csv",row.names=FALSE) - - - - for (i in 1:nrow(x)){ - p <- x[i,] - q <- y[i,] - if (min(signif(as.numeric(p[sapply(p,FUN=is.numeric) & !is.na(p)]),3) ==signif(as.numeric(q[sapply(q,FUN=is.numeric) & !is.na(q)]),3)) == 0){ - writeLines(paste("Difference detected for analysisId",analysis_id)) - break - } - } } \ No newline at end of file From 464da92db835473dbe7f5d13e55344789879edf3 Mon Sep 17 00:00:00 2001 From: Martijn Schuemie Date: Thu, 18 Sep 2014 10:03:54 +0200 Subject: [PATCH 6/7] Removed RTools dependency from readme file SqlRender now uses Java, not C++, so don't need compiler anymore. --- README.md | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index 375bd075..3ae943de 100644 --- a/README.md +++ b/README.md @@ -11,9 +11,7 @@ Getting Started 2. Make sure that you have Java installed. If you don't have Java already intalled on your computed (on most computers it already is installed), go to [java.com](http://java.com) to get the latest version. (If you have trouble building with rJava below, be sure on Windows that your Path variable includes the path to jvm.dll (Windows Button --> type "path" --> Edit Environmental Variables --> Edit PATH variable, add to end ;C:/Program Files/Java/jre/bin/server) or wherever it is on your system.) -3. If you're using Windows, make sure you install [RTools](http://cran.r-project.org/bin/windows/Rtools/). - -4. in R, use the following commands to install Achilles: +3. in R, use the following commands to install Achilles: ```r install.packages("devtools") @@ -23,7 +21,7 @@ Getting Started install_github("ohdsi/Achilles") ``` -5. To run the Achilles analysis, use the following commands in R: +4. To run the Achilles analysis, use the following commands in R: ```r library(Achilles) @@ -36,7 +34,7 @@ Getting Started ``` Currently "sql server", "oracle", "postgresql", and "redshift" are supported as dbms. -6. To use [AchillesWeb](https://github.com/OHDSI/AchillesWeb) to explore the Achilles statistics, you must first export the statistics to JSON files: +5. To use [AchillesWeb](https://github.com/OHDSI/AchillesWeb) to explore the Achilles statistics, you must first export the statistics to JSON files: ```r exportToJson(connectionDetails, "cdm4_inst", "results", "c:/myPath/AchillesExport") ``` From 6723f5039bf36d83d9c0e37189e3cc11a2fdddc2 Mon Sep 17 00:00:00 2001 From: schuemie Date: Mon, 20 Oct 2014 09:54:21 -0400 Subject: [PATCH 7/7] Fixed crash on Postgres and Oracle --- inst/sql/sql_server/Achilles.sql | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/sql/sql_server/Achilles.sql b/inst/sql/sql_server/Achilles.sql index 93fc1297..f89d58b9 100644 --- a/inst/sql/sql_server/Achilles.sql +++ b/inst/sql/sql_server/Achilles.sql @@ -1478,7 +1478,7 @@ from ) pc on pc.PLACE_OF_SERVICE_CONCEPT_ID = vo1.PLACE_OF_SERVICE_CONCEPT_ID ) Q ) t1 -group by place_of_service_concept_id +group by place_of_service_concept_id; --}