BPJS_Wrangling_2015_2016.R

library(dplyr)
library(rio)
library(data.table)


pst_20152016 <- import("D:/Projects/Data Sampel BPJS Kesehatan Edisi August2019/01 KEPESERTAAN 260819.dta")
kunFKL_20152016 <- import("D:/Projects/Data Sampel BPJS Kesehatan Edisi August2019/04 FKRTL 260819.dta")
kunFKP_20152016 <- import("D:/Projects/Data Sampel BPJS Kesehatan Edisi August2019/02 FKTP Kapitasi 260819.dta")
kunPNK_20152016 <- import("D:/Projects/Data Sampel BPJS Kesehatan Edisi August2019/03 FKTP Non Kapitasi 260819.dta")
# FKLdx2nd <- import("D:/Projects/Data Sampel BPJS Kesehatan Edisi August2019/05 FKRTL Diagnosis Sekunder 260819.dta")
# refloc <- import("source/refPolg.xlsx")

colnames(pst_20152016) <- c(
  # Identifier numbers
  "NoPeserta", "NoKeluarga", 
  # Some backgrounds
  "TglLahir", "HubKeluarga", "JenisKelamin", "StatusKawin", 
  # Membership information
  "KelasRawat", "SegmenPeserta",
  # Home location
  "ProvPeserta", "KabPeserta", 
  # Registered Faskes
  "PemilikFaskesTerdaftar", "JenisFaskesTerdaftar", "ProvFaskesTerdaftar", "KabFaskesTerdaftar", 
  # Calculated variables
  "BobotIndividu", 
  # Status peserta
  "umur", "kat_umur"
)

colnames(kunFKL_20152016) <- c(
  # Identifiers
  "NoPeserta", "NoKeluarga", "Bobot", #"IDkunjunganFKTP", 
  "IDkunjungan", "TglDatang", "TglPulang", 
  # Faskes information
  "ProvFaskes", "KabFaskes", "PemilikFaskes", "JenisFaskes", "TipeFaskes", "TingkatLayanan",
  # Admission status
  "Poli", "Segmen", "KelasFKL", "StatusPulang",
  # Diagnoses on admission
  "DxMasuk_namecode", "DxMasukLong_code", "DxMasukLong_name", 
  # Primary diagnoses
  "DxPrimer_namecode", "DxPrimerLong_code", "DxPrimerLong_name",
  # INA-CBG's specifications
  "CBG_code", "CBG_name", "CMG", "TipeKasus", "SpesifikasiKasus", "Severity",
  # Referral origin
  "ProvAsal", "KabAsal", "PemilikFaskesAsal", "JenisFaskesAsal", 
  "TipeFaskesAsal", "Prosedur", "Regional",
  # Tariff
  "GroupTarif", 
  ## Sub-acute Group
  "SA_code", "SA_tariff", 
  ## Special Procedure Group
  "SP_code", "SP_desc", "SP_tariff",
  ## Special prosthesis
  "RR_code", "RR_desc", "RR_tariff", 
  ## Special investigation
  "SI_code", "SI_desc", "SI_tariff",
  ## Special Drugs
  "SD_code", "SD_desc", "SD_tariff", 
  ## Total
  "BiayaTagih", "BiayaVerifikasi"
)

colnames(kunFKP_20152016) <- c(
  # Identifiers
  "NoPeserta", "Bobot", "IDkunjungan", "TglDatang", "TglPulang", 
  # Faskes information
  "ProvFaskes", "KabFaskes", "PemilikFaskes", "JenisFaskes", "TipeFaskes", "TingkatLayanan",
  # Admission status
  "Poli", "Segmen", "StatusPulang",
  # Diagnoses on admission
  "DxMasuk_namecode", "DxMasukLong_code", "DxMasukLong_name",  
  # Referral destination
  "ProvRujukan", "KabRujukan", "PemilikFaskesRujukan", "JenisFaskesRujukan", 
  "TipeFaskesRujukan", "PoliRujukan", "JenisKunjungan", "NoKeluarga"
)

colnames(kunPNK_20152016) <- c(
  # Identifiers
  "NoPeserta", "Bobot", "IDkunjungan", "TglDatang", "TglTindakan", "TglPulang", 
  # Faskes information
  "ProvFaskes", "KabFaskes", "PemilikFaskes", "JenisFaskes", "TipeFaskes", "TingkatLayanan",
  # Admission status
  "Segmen",
  # Diagnoses on admission
  "DxMasuk_namecode", "DxMasukLong_code", "DxMasukLong_name", "NamaTindakan",
  # Tariff
  "BiayaTagih", "BiayaVerifikasi", "NoKeluarga"
)


peserta_20152016 <- pst_20152016 %>% 
  mutate_at(
    vars(matches("Prov"), matches("Kab"), matches("Bobot"), matches("Tahun"), NoPeserta, NoKeluarga), 
    as.numeric
  ) %>% 
  characterize(.)
rm("pst_20152016")

kunjunganFKL_20152016 <- kunFKL_20152016 %>% 
  mutate_at(
    vars(matches("Prov"), matches("Kab"), matches("Bobot"), matches("Biaya"), matches("tariff"), matches("Tahun"), NoPeserta, NoKeluarga), 
    as.numeric
  ) %>% 
  characterize(.)
rm("kunFKL_20152016")

kunjunganFKP_20152016 <- kunFKP_20152016 %>% 
  mutate_at(
    vars(matches("Prov"), matches("Kab"), matches("Bobot"), matches("Tahun"), NoPeserta, NoKeluarga), 
    as.numeric
  ) %>% 
  characterize(.)
rm("kunFKP_20152016")

kunjunganPNK_20152016 <- kunPNK_20152016 %>%
  mutate_at(
    vars(matches("Prov"), matches("Kab"), matches("Biaya"), matches("Tahun"), NoPeserta, NoKeluarga), 
    as.numeric
  ) %>% 
  characterize(.)
rm("kunPNK_20152016")


# Change "MISSING" to NA
source("../BPJS-Pre-Processing/helperFun.R")

peserta_20152016 <- stripAttr(peserta_20152016) %>%
  mutate_at(vars(-TglLahir), function(x) ifelse(x == "MISSING", NA, x)) %>%
  mutate_at(vars(-TglLahir), function(x) ifelse(x == "Missing", NA, x)) %>% 
  mutate_at(vars(-TglLahir), function(x) ifelse(x == "", NA, x))

kunjunganFKL_20152016 <- stripAttr(kunjunganFKL_20152016) %>%
  mutate_at(vars(-TglDatang, -TglPulang), function(x) ifelse(x == "MISSING", NA, x)) %>%
  mutate_at(vars(-TglDatang, -TglPulang), function(x) ifelse(x == "", NA, x))


kunjunganFKP_20152016 <- stripAttr(kunjunganFKP_20152016) %>%
  mutate_at(vars(-TglDatang, -TglPulang), function(x) ifelse(x == "MISSING", NA, x)) %>%
  mutate_at(vars(-TglDatang, -TglPulang), function(x) ifelse(x == "", NA, x))


kunjunganPNK_20152016 <- stripAttr(kunjunganPNK_20152016) %>%
  mutate_at(vars(-TglDatang, -TglTindakan, -TglPulang), function(x) ifelse(x == "MISSING", NA, x)) %>%
  mutate_at(vars(-TglDatang, -TglTindakan, -TglPulang), function(x) ifelse(x == "", NA, x))

# Create greater categories for TipeFaskes
hosref <- cbind(
  TipeFaskes = data.frame(table(kunjunganFKL_20152016$TipeFaskes))[1],
  KatUmum = c("RS Khusus", "RS Khusus", "RS Khusus", "RS Khusus", "RS Khusus",
              "RS Khusus", "RS Khusus", "RS Khusus", "RS Khusus", "RS Khusus",
              "RS Khusus", "RS Khusus", "RS Khusus", "Lainnya", "RS Kelas A",
              "RS Kelas B", "RS Kelas C", "RS Kelas D", "Lainnya", "RS Kelas A",
              "RS Kelas B", "RS Kelas C", "RS Kelas D", "RS TNI Polri", "RS TNI Polri",
              "RS TNI Polri", "RS TNI Polri")
)

kunjunganFKL_20152016$TipeFaskes_umum <- kunjunganFKL_20152016$TipeFaskes
kunjunganFKL_20152016 <- replace_all(kunjunganFKL_20152016, vars = "TipeFaskes_umum",
                            list = as.vector(hosref$Var1),
                            values = as.vector(hosref$KatUmum))
kunjunganFKP_20152016$TipeFaskesRujukan_group <- kunjunganFKP_20152016$TipeFaskesRujukan
kunjunganFKP_20152016 <- replace_all(kunjunganFKP_20152016, vars = c("TipeFaskesRujukan_group"),
                            list = as.vector(hosref$Var1),
                            values = as.vector(hosref$KatUmum))

# Change problematic province codes
kunjunganFKL_20152016$ProvFaskes <- floor(kunjunganFKL_20152016$KabFaskes/100)
kunjunganPNK_20152016$ProvFaskes <- floor(kunjunganPNK_20152016$KabFaskes/100)

# Add regional group
refloc_prov <- tibble(Provinsi = unique(refloc$Provinsi), Provinsi_code = unique(refloc$Provinsi_code))
reg_conv <- import("../BPJS-Pre-processing/data_in/reg_conv.csv")

peserta_20152016 <- peserta_20152016 %>%
  mutate(RegPeserta = ProvPeserta, RegFaskesTerdaftar = ProvFaskesTerdaftar) %>%
  replace_all(vars = "Reg",
              list = reg_conv$Prov, values = reg_conv$Reg) %>%
  replace_all(vars = "Prov",
              list = refloc_prov$Provinsi_code, values = refloc_prov$Provinsi) %>%
  replace_all(vars = "Kab",
              list = refloc$KabKota_code, values = refloc$KabKota)

kunjunganFKL_20152016 <- kunjunganFKL_20152016 %>% 
  mutate(RegAsal = ProvAsal, RegFaskes = ProvFaskes) %>%
  replace_all(vars ="Reg",
              list = reg_conv$Prov, values = reg_conv$Reg) %>%
  replace_all(vars = "Prov",
              list = refloc_prov$Provinsi_code, values = refloc_prov$Provinsi) %>%
  replace_all(vars = "Kab",
              list = refloc$KabKota_code, values = refloc$KabKota)


kunjunganFKP_20152016 <- kunjunganFKP_20152016 %>% 
  mutate(RegFaskes = ProvFaskes, RegRujukan = ProvRujukan) %>%
  replace_all(vars = "Reg",
              list = reg_conv$Prov, values = reg_conv$Reg) %>%
  replace_all(vars = "Prov",
              list = refloc_prov$Provinsi_code, values = refloc_prov$Provinsi) %>%
  replace_all(vars = "Kab",
              list = refloc$KabKota_code, values = refloc$KabKota)

kunjunganPNK_20152016 <- kunjunganPNK_20152016 %>% 
  mutate(RegFaskes = ProvFaskes) %>%
  replace_all(vars = "Reg",
              list = reg_conv$Prov, values = reg_conv$Reg) %>%
  replace_all(vars = "Prov",
              list = refloc_prov$Provinsi_code, values = refloc_prov$Provinsi) %>%
  replace_all(vars = "Kab",
              list = refloc$KabKota_code, values = refloc$KabKota)


peserta_20152016 <- peserta_20152016 %>%
  mutate(SegmenPeserta = ifelse(SegmenPeserta == "BUKAN PEKERJA", "Bukan pekerja", SegmenPeserta))
kunjunganFKL_20152016 <- kunjunganFKL_20152016 %>%
  mutate(Segmen = ifelse(Segmen == "BUKAN PEKERJA", "Bukan pekerja", Segmen))
kunjunganFKP_20152016 <- kunjunganFKP_20152016 %>%
  mutate(Segmen = ifelse(Segmen == "BUKAN PEKERJA", "Bukan pekerja", Segmen))
kunjunganPNK_20152016 <- kunjunganPNK_20152016 %>%
  mutate(Segmen = ifelse(Segmen == "BUKAN PEKERJA", "Bukan pekerja", Segmen))

kunjunganFKL <- kunjunganFKL %>%
  mutate(Segmen = ifelse(Segmen == "Bukan Pekerja", "Bukan pekerja", Segmen))
kunjunganFKP_20152016 <- kunjunganFKP_20152016 %>%
  mutate(Segmen = ifelse(Segmen == "Bukan Pekerja", "Bukan pekerja", Segmen))
kunjunganPNK_20152016 <- kunjunganPNK_20152016 %>%
  mutate(Segmen = ifelse(Segmen == "Bukan Pekerja", "Bukan pekerja", Segmen))

# Export processed dataset
export(peserta_20152016, "output/base/peserta_20152016.rds")
export(kunjunganFKL_20152016, "output/base/kunjunganFKL_20152016.rds")
export(kunjunganFKP_20152016, "output/base/kunjunganFKP_20152016.rds")
export(kunjunganPNK_20152016, "output/base/kunjunganPNK_20152016.rds")

helperFun.R

replace_all <- function(data, vars, list, values) {
  require(dplyr)
  n <- length(list)
  res <- data
  for(i in 1:n) {
    res <- as.data.frame(res) %>% 
      mutate_at(vars(matches(vars)), ~ replace(. , which(. == list[i]), values[i]))
    
  }
  res
}
simpleCap <- function(x) {
  x <- tolower(x)
  s <- strsplit(x, " ")[[1]]
  paste(toupper(substring(s, 1,1)), substring(s, 2),
        sep="", collapse=" ")
}

stripAttr <- function (data) 
{
  good <- c("names", "row.names", "class")
  for (h in colnames(data)){
    attr <- names(attributes(data[[h]]))
    for (i in attr[!attr %in% good]) {
      attr(data[[h]], i) <- NULL
    }
  }
  return(data)
}