Merge pull request #93 from rfsaldanha/v2.2.3

V2.2.3

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: microdatasus
 Title: Download and preprocess DataSUS files
-Version: 2.2.2
+Version: 2.2.3
 Authors@R: 
     person(given = "Raphael",
            family = "Saldanha",
@@ -15,7 +15,7 @@ Encoding: UTF-8
 LazyData: true
 LazyDataCompression: bzip2
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Imports: 
     curl,
     data.table,
@@ -25,6 +25,8 @@ Imports:
     read.dbc,
     stringi,
     utils
+Remotes:
+    danicat/read.dbc
 Suggests: 
     testthat (>= 3.0.0)
 Config/testthat/edition: 3

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(fetch_datasus)
+export(fetch_sigtab)
 export(process_cnes)
 export(process_sia)
 export(process_sih)

NEWS.md

@@ -1,3 +1,10 @@
+# microdatasus 2.2.3
+* As the package {read.dbc} is not available on CRAN, this patch uses the Github version.
+* Issue #89 points out that files from SIM-EXT older than 2006 present 7-digits variable lengths for CODMUNRES and CODMUNOCOR. Those codes are now truncated to 6-digits standard by process_sim function.
+* Related to #66, #84 and #86. Some files are very big to download, especially those from SIA and SIH. A timeout argument was added to the fetch_datasus with a default of 240 seconds.
+* process_sinasc pull request #91 fixes issue #90, related to CODOCUPMAE variable
+* Related to #79, now the function process_sia downloads an updated version from the SIGTAB table from DataSUS when nome_proced is TRUE. 
+
 # microdatasus 2.2.2
 * process_sinasc correct old code for missing on ESCMAE
 

R/fetch_datasus.R

@@ -14,6 +14,7 @@
 #' @param information_system string. The abbreviation of the health information system to be accessed. See \emph{Details}.
 #' @param vars an optional string or a vector of strings. By default, all variables read and stored, unless a list of desired variables is informed by this parameter.
 #' @param stop_on_error logical. If TRUE, the download process will be stopped if an error occurs.
+#' @param timeout numeric (seconds). Sets a timeout tolerance for downloads, usefull on large files and/or slow connections. Defaults to 240 seconds.
 #'
 #' @section Warning:
 #' A Internet connection is needed to use this function.
@@ -39,7 +40,14 @@
 #' }
 #' @export
 
-fetch_datasus <- function(year_start, month_start, year_end, month_end, uf = "all", information_system, vars = NULL, stop_on_error = FALSE){
+fetch_datasus <- function(year_start, month_start, year_end, month_end, uf = "all", information_system, vars = NULL, stop_on_error = FALSE, timeout = 240){
+  # Resets original timeout option on function exit
+  original_time_option <- getOption("timeout")
+  on.exit(options(timeout = original_time_option))
+
+  # Set new timeout
+  options(timeout = timeout)
+
   # Verify health information system
   sisSIH <- c("SIH-RD","SIH-RJ","SIH-SP","SIH-ER")
   sisSIM <- c("SIM-DO", "SIM-DOFET","SIM-DOEXT","SIM-DOINF","SIM-DOMAT")
@@ -1196,6 +1204,7 @@ fetch_datasus <- function(year_start, month_start, year_end, month_end, uf = "al
     error=function(cond) {
       message(paste("Something went wrong with this URL:", file))
       message("This can be a problem with the Internet or the file does not exist yet.")
+      message("If the file is too big, try to increase the timeout argument value.")
 
       if(stop_on_error == TRUE){
         stop("Stopping download.")

R/fetch_sigtab.R

@@ -0,0 +1,63 @@
+#' Fetch SIGTAB table
+#'
+#' This function fetchs an updated table of procedures (SIGTAB) from DatasSUS
+#'
+#' @param timeout sets the download timeout reference. Defaults to 240
+#'
+#' @return a data.frame
+#' @export
+fetch_sigtab <- function(timeout = 240){
+  # Resets original timeout option on function exit
+  original_time_option <- getOption("timeout")
+  on.exit(options(timeout = original_time_option))
+
+  # Set new timeout
+  options(timeout = timeout)
+
+  sigtab_url <- "ftp://ftp.datasus.gov.br/dissemin/publicos/SIASUS/200801_/Auxiliar/TAB_SIA.zip"
+
+  # Temporary file and dir
+  temp_file <- tempfile()
+  temp_dir <- tempdir()
+
+  # Check local Internet connection
+  local_internet <- curl::has_internet()
+  if(local_internet == TRUE){
+    message("Your local Internet connection seems to be ok.")
+  } else {
+    stop("It appears that your local Internet connection is not working. Can you check?")
+  }
+
+  # Check DataSUS FTP server
+  remote_file_is_availabe <- RCurl::url.exists("ftp.datasus.gov.br")
+  if(remote_file_is_availabe == TRUE){
+    message("DataSUS FTP server seems to be up. Starting download...")
+  } else {
+    message("It appears that DataSUS FTP is down. I will try to download the files anyway...")
+  }
+
+  # Try to download file
+  tryCatch({
+    utils::download.file(sigtab_url, temp_file, mode = "wb", method = "libcurl")
+  },
+  error=function(cond) {
+    message(paste("Something went wrong while trying to download SIGTAB table. URL:", file))
+
+    if(stop_on_error == TRUE){
+      stop("Stopping download.")
+    }
+  })
+
+  # sigtab file address
+  sigtab_file <- file.path("DBF/TB_SIGTAW.dbf")
+
+  # Unzip
+  zip::unzip(zipfile = temp_file, exdir = temp_dir, overwrite = TRUE, files = sigtab_file)
+
+  # Read and change columns names
+  tmp <- foreign::read.dbf(file = file.path(temp_dir, sigtab_file))
+  colnames(tmp) <- c("COD", "nome_proced")
+
+  # Return sigtab data frame
+  return(tmp)
+}

R/process_sia.R

@@ -8,7 +8,7 @@
 #'
 #' @param data \code{data.frame} created by \code{fetch_datasus()}.
 #' @param information_system string. The abbreviation of the health information system. See \emph{Details}.
-#' @param nome_proced optional logical. \code{TRUE} by default, add  \code{PA_PROCED_NOME} to the dataset.
+#' @param nome_proced optional logical. \code{TRUE} by default, add  \code{PA_PROCED_NOME} to the dataset. This setting will start to download a file from DataSUS to retrive the updates list of procesures (SIGTAB).
 #' @param nome_ocupacao optional logical. \code{TRUE} by default, add  \code{OCUPACAO} name to the dataset.
 #' @param nome_equipe optional logical. \code{TRUE} by default, add  \code{EQUIPE} name to the dataset.
 #' @param municipality_data optional logical. \code{TRUE} by default, creates new variables in the dataset informing the full name and other details about the municipality of residence.
@@ -134,7 +134,8 @@ process_sia <- function(data, information_system = "SIA-PA", nome_proced = TRUE,
 
     # PA_PROC_NOME
     if(nome_proced == TRUE){
-      data <- dplyr::left_join(data, microdatasus::sigtab, by = c("PA_PROC_ID" = "COD"))
+      sigtab_temp <- microdatasus::fetch_sigtab()
+      data <- dplyr::left_join(data, sigtab_temp, by = c("PA_PROC_ID" = "COD"))
     }
 
     # PA_TPFIN

R/process_sim.R

@@ -176,12 +176,23 @@ process_sim <- function(data, municipality_data = TRUE) {
   }
 
   # CODMUNRES
-  if ("CODMUNRES" %in% variables_names & municipality_data == TRUE) {
+  if ("CODMUNRES" %in% variables_names){
+    if(nchar(data$CODMUNRES[1]) == 7){
+      data$CODMUNRES <- substr(data$CODMUNRES, 0, 6)
+    }
+  } else if ("CODMUNRES" %in% variables_names & municipality_data == TRUE) {
     colnames(tabMun)[1] <- "CODMUNRES"
     tabMun$CODMUNRES <- as.character(tabMun$CODMUNRES)
     data <- dplyr::left_join(data, tabMun, by = "CODMUNRES")
   }
 
+  # CODMUNOCOR
+  if ("CODMUNOCOR" %in% variables_names){
+    if(nchar(data$CODMUNOCOR[1]) == 7){
+      data$CODMUNOCOR <- substr(data$CODMUNOCOR, 0, 6)
+    }
+  }
+
   # LOCOCOR
   if ("LOCOCOR" %in% variables_names) {
     data$LOCOCOR <- as.numeric(data$LOCOCOR)