R/TransferInclusionCriteria.R

In A1exanderAlexeyuk/ODYPACK:

#' @importFrom magrittr %>%
#'
#'
#' @export

transferInclusionCriteria <- function(
  jsonToGetInclusionCriteriaPath,
  jsonToPutInclusionCriteriaPath,
  inclusionRuleName
) {
  jsonToGet <- rjson::fromJSON(file = jsonToGetInclusionCriteriaPath)
  jsonToPut <- rjson::fromJSON(file = jsonToPutInclusionCriteriaPath)
  lengthOfIR <- length(jsonToPut$InclusionRules)
  lengthOfConceptSets <- length(jsonToPut$ConceptSets)

  for(i in 1:length(jsonToGet$InclusionRules)) {
    if(jsonToGet$InclusionRules[[i]]["name"] %in% inclusionRuleName) {
      jsonToPut$InclusionRules[[lengthOfIR + 1]] <- append(
        jsonToGet$InclusionRules,
        jsonToGet$InclusionRules[[i]])
      for(inn in 1:length(jsonToPut$InclusionRules[[lengthOfIR + 1]]$expression$CriteriaList)) {
        idIR <- jsonToPut$InclusionRules[[lengthOfIR + 1]]$expression$CriteriaList[[inn]][[1]][[1]][[1]]
        jsonToPut$InclusionRules[[lengthOfIR + 1]]$expression$CriteriaList[[inn]][[1]][[1]][[1]] <- idIR + 50
      }
      includedConceptIds <- c()
      for(char in 1:length(jsonToGet$InclusionRules[[i]]$expression$CriteriaList)) {
        idToInput <- try(jsonToGet$InclusionRules[[i]]$expression$CriteriaList[[char]][[1]][[1]][[1]], silent = T)
        includedConceptIds <- append(
          includedConceptIds,
          idToInput
        )
      }
      for(setN in 1:length(jsonToGet$ConceptSets)) {
        uniq <- unique(includedConceptIds)
        for(id in uniq) {
          if(jsonToGet$ConceptSets[[setN]][[1]] == id) {
            setToInput <- jsonToGet$ConceptSets[[setN]]
            jsonToPut$ConceptSets[[length(jsonToPut$ConceptSets) + 1]] <- append(
              jsonToGet$ConceptSets,
              setToInput
            )
            jsonToPut$ConceptSets[[length(jsonToPut$ConceptSets)]]$id <- id + 50
          }
        }

      }
    }
  }
  jsonOut <- RJSONIO::toJSON(jsonToPut)
  write(jsonOut, jsonToPutInclusionCriteriaPath)
  #return(jsonOut)
}






#' @export
#'
#'
getCohortsToTransfer <- function(
  baseUrl,
  authMethod = "db",
  webApiUsername,
  webApiPassword,
  atlasCohortIdToGetCriteria,
  atlasCohortIdToPutCriteria
) {
  httr::set_config(httr::config(ssl_verifypeer = FALSE))
    sqls <- list.files(path = 'inst/sql/sql_server',
                       recursive = F,
                       pattern = "\\.sql",
                       full.names = F)

    unlink("inst/cohorts/*")
    for(sql in unlist(sqls)) {
      if(
        !sql %in% c(
          "CreateCohortTable.sql",
          "ProviderInfo.sql",
          "CreateDemographicData.sql",
          "CreateDenominatorDemographicData.sql"
        )
      ) {
        unlink(paste0("inst/sql/sql_server/", sql))
      }
    }



  ROhdsiWebApi::authorizeWebApi(
    baseUrl,
    authMethod = "db",
    webApiUsername = webApiUsername,
    webApiPassword = webApiPassword
  )

  for(cohortId in c(atlasCohortIdToGetCriteria, atlasCohortIdToPutCriteria)) {
    ROhdsiWebApi::insertCohortDefinitionInPackage(
      cohortId = cohortId,
      baseUrl = baseUrl)
  }
}



#' @export
#'
#'
postPreparedCohort <- function(
  baseUrl,
  authMethod = "db",
  webApiUsername,
  webApiPassword,
  jsonToPut,
  cohortName
) {

  ROhdsiWebApi::authorizeWebApi(
    baseUrl,
    authMethod = "db",
    webApiUsername = webApiUsername,
    webApiPassword = webApiPassword
  )

  ROhdsiWebApi::postCohortDefinition(
    name = cohortName,
    cohortDefinition = jsonlite::read_json(jsonToPut),
    baseUrl = baseUrl
  )
}