R/LoadCohort.R

In ABMI/PathwayVisualizer:

# Copyright 2020 Observational Health Data Sciences and Informatics
#
# This file is part of PathwayVisualizer
#
# 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.

# Load Data
#' @import DatabaseConnector
#' @import SqlRender

#' @export
cohortDescription <- function(){

  cohortDescriptionPath <- system.file("csv", "CohortDescription.csv", package = "PathwayVisualizer")
  cohortDescription <- read.csv(cohortDescriptionPath,stringsAsFactors = F)

  return(cohortDescription)

}

#' @export
loadCohort <- function(connectionDetails,
                       cohortDatabaseSchema,
                       cohortTable,
                       targetCohortIds){
  # DB connection
  connection <- DatabaseConnector::connect(connectionDetails)

  sql <- 'SELECT * FROM @result_database_schema.@cohort_table WHERE cohort_definition_id IN (@target_cohort_ids)'

  sql <- SqlRender::render(sql,
                           result_database_schema = cohortDatabaseSchema,
                           cohort_table = cohortTable,
                           target_cohort_ids= targetCohortIds)

  sql <- SqlRender::translate(sql, targetDialect = connectionDetails$dbms)

  cohort <- DatabaseConnector::querySql(connection, sql)

  colnames(cohort) <- SqlRender::snakeCaseToCamelCase(colnames(cohort))
  # DB disconnection
  DatabaseConnector::disconnect(connection)

  return(cohort)
}

#' @export
cohortNumbering <- function(connectionDetails,
                            cohortDatabaseSchema,
                            conditionCohortTable,
                            conditionCohortIds = NULL,
                            cohortRecords,
                            cohortDescript,
                            identicalSeriesCriteria){

  # Condition Criteria
  if(!is.null(conditionCohortIds)){


    conditionCohort <- loadCohort(connectionDetails,
                                  cohortDatabaseSchema,
                                  conditionCohortTable,
                                  conditionCohortIds)

    cycleCohort <- cohortRecords %>% subset(subjectId %in% conditionCohort$subjectId)

  }

  # Numbering cycle
  cycleCohort <- cohortRecords

  cycleCohort$cohortStartDate <- as.Date(cycleCohort$cohortStartDate)
  cycleCohort$cohortEndDate <- as.Date(cycleCohort$cohortEndDate)
  cycleCohort <- dplyr::left_join(cycleCohort,cohortDescript, by= c("cohortDefinitionId"="cohortDefinitionId"))
  cohortWtDiff <- cycleCohort %>% group_by(subjectId,cohortDefinitionId) %>% arrange(subjectId,cohortStartDate) %>% mutate(dateDiff = (cohortStartDate-lag(cohortStartDate)))
  cohortWtDiff$dateDiff <- as.numeric(cohortWtDiff$dateDiff)
  cohortWtDiff$flagSeq <- NA
  cohortWtDiff$flagSeq[is.na(cohortWtDiff$dateDiff)|cohortWtDiff$dateDiff >= identicalSeriesCriteria] <- 1
  standardCycle <- data.table::as.data.table(cohortWtDiff)
  standardCycle[, cycle := seq_len(.N), by=.(cumsum(!is.na(flagSeq)))]
  standardCycle <- standardCycle %>% select(cohortDefinitionId,subjectId,cohortStartDate,cohortEndDate,cohortName,cycle)

  numberedRecords <- data.frame(standardCycle)

  return(numberedRecords)
}