Introduction

In this section we will:

  • identify which Office Visit procedures were excluded and why
  • identify which different Office Visit subgroups were created and why

If you have questions or concerns about this data please contact Alexander Nielson (alexnielson@utah.gov)

Load Libraries

Load Libraries

library(data.table)
library(tidyverse)

## Warning: replacing previous import 'vctrs::data_frame' by 'tibble::data_frame'
## when loading 'dplyr'

library(stringi)
library(ggridges)
library(broom)
library(disk.frame)
library(RecordLinkage)
library(googlesheets4)
library(bigrquery)
library(DBI)
devtools::install_github("utah-osa/hcctools2", upgrade="never" )
library(hcctools2)

Establish color palettes

cust_color_pal1 <- c(
        "Anesthesia" = "#f3476f",
        "Facility" = "#e86a33",
        "Medicine Proc" = "#e0a426",
        "Pathology" = "#77bf45",
        "Radiology" = "#617ff7",
        "Surgery" = "#a974ee"
    )

cust_color_pal2 <- c(
        "TRUE" = "#617ff7",
        "FALSE" = "#e0a426"
    )

cust_color_pal3 <- c(
        "above avg" = "#f3476f",
        "avg" = "#77bf45",
        "below avg" = "#a974ee"
    )



  fac_ref_regex <- "(UTAH)|(IHC)|(HOSP)|(HOSPITAL)|(CLINIC)|(ANESTH)|(SCOPY)|(SURG)|(LLC)|(ASSOC)|(MEDIC)|(CENTER)|(ASSOCIATES)|(U OF U)|(HEALTH)|(OLOGY)|(OSCOPY)|(FAMILY)|(VAMC)|(SLC)|(SALT LAKE)|(CITY)|(PROVO)|(OGDEN)|(ENDO )|( VALLEY)|( REGIONAL)|( CTR)|(GRANITE)|( INSTITUTE)|(INSTACARE)|(WASATCH)|(COUNTY)|(PEDIATRIC)|(CORP)|(CENTRAL)|(URGENT)|(CARE)|(UNIV)|(ODYSSEY)|(MOUNTAINSTAR)|( ORTHOPEDIC)|(INSTITUT)|(PARTNERSHIP)|(PHYSICIAN)|(CASTLEVIEW)|(CONSULTING)|(MAGEMENT)|(PRACTICE)|(EMERGENCY)|(SPECIALISTS)|(DIVISION)|(GUT WHISPERER)|(INTERMOUNTAIN)|(OBGYN)"

Connect to GCP database

bigrquery::bq_auth(path = 'D:/gcp_keys/healthcare-compare-prod-95b3b7349c32.json')

# set my project ID and dataset name
project_id <- 'healthcare-compare-prod'
dataset_name <- 'healthcare_compare'

con <- dbConnect(
  bigrquery::bigquery(),
  project = project_id,
  dataset = dataset_name,
  billing = project_id
)

Get NPI table

query <-  paste0("SELECT npi, clean_name, osa_group, osa_class, osa_specialization
                 FROM `healthcare-compare-prod.healthcare_compare.npi_full`")
                       
#bq_project_query(billing, query) # uncomment to determine billing price for above query.

npi_full <- dbGetQuery(con, query) %>%
  data.table()

get a subset of the NPI providers based upon taxonomy groups

  npi_prov_pair <-  npi_full%>% 
    .[,.(npi=npi,
         clean_name = clean_name
         )
      ]

Load Data

bun_proc <-  disk.frame("full_apcd.df")

# checkup <- bun_proc[faci_bun %>%  stri_detect_regex("(99201)|(99202)|(99203)|(99204)|(99205)|(99211)|(99212)|(99213)
# (99214)|(99215)") &
#   surg_bun==""  & medi_bun==""   & radi_bun=="" & path_bun=="" & anes_bun==""]

checkup <- bun_proc[(faci_bun =="99201" |
faci_bun == "99202" |
faci_bun == "99203" |
faci_bun == "99204" |
faci_bun == "99205" |
faci_bun == "99211" |
faci_bun == "99212" |
faci_bun == "99213" |
faci_bun == "99214" |
faci_bun == "99215") &
  surg_bun==""  & medi_bun==""   & radi_bun=="" & path_bun=="" & anes_bun==""]

checkup %>% nrow()

## [1] 358443

checkup <- checkup[cnt > 4 & tp_med < 1000 & tp_med > 0]

checkup %>% nrow()

## [1] 71380

checkup %>% plot_med_density() %>% print()

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.


checkup %>% get_tag_cor() %>% print()

## Warning in stats::cor(cor_data): the standard deviation is zero

## # A tibble: 3 x 2
##   name           correlation
##   <chr>                <dbl>
## 1 faci_bun_t_est      0.349 
## 2 duration_mean       0.0017
## 3 duration_max        0.0007

checkup %>% get_tag_density_information("faci_bun_t_est") %>% print()

## Scale for 'y' is already present. Adding another scale for 'y', which will
## replace the existing scale.

## Scale for 'x' is already present. Adding another scale for 'x', which will
## replace the existing scale.

## [1] "tp_med ~ faci_bun_t_est"

## Warning in leveneTest.default(y = y, group = group, ...): group coerced to
## factor.

## Picking joint bandwidth of 5.74

## $dist_plots


## 
## $stat_tables


checkup_est <- checkup[faci_bun_t_est==T]

checkup_new <- checkup[faci_bun_t_est==F]

checkup_new <-  checkup_new[,`:=`(
  surg_sp_name_clean = surg_sp_npi %>% map_chr(get_npi_standard_name),
  surg_bp_name_clean = surg_bp_npi %>% map_chr(get_npi_standard_name),

  medi_sp_name_clean = medi_sp_npi %>% map_chr(get_npi_standard_name),
  medi_bp_name_clean = medi_bp_npi %>% map_chr(get_npi_standard_name),

  radi_sp_name_clean = radi_sp_npi %>% map_chr(get_npi_standard_name),
  radi_bp_name_clean = radi_bp_npi %>% map_chr(get_npi_standard_name),

  path_sp_name_clean = path_sp_npi %>% map_chr(get_npi_standard_name),
  path_bp_name_clean = path_bp_npi %>% map_chr(get_npi_standard_name),

  anes_sp_name_clean = anes_sp_npi %>% map_chr(get_npi_standard_name),
  anes_bp_name_clean = anes_bp_npi %>% map_chr(get_npi_standard_name),

  faci_sp_name_clean = faci_sp_npi %>% map_chr(get_npi_standard_name),
  faci_bp_name_clean = faci_bp_npi %>% map_chr(get_npi_standard_name)
                           )]

checkup_new_btb4 <- checkup_new %>% btbv4()

checkup_new_bq <- checkup_new_btb4 %>%
    .[is.na(doctor_str2)] %>%
  .[,`:=`(procedure_type=10, procedure_modifier="New Patient")] %>%
  .[,.(
  primary_doctor = doctor_str1,
  primary_doctor_npi = doctor_npi_str1 ,
  most_important_fac	,
  most_important_fac_npi,
  procedure_type,
  procedure_modifier,
  tp_med_med,
  tp_med_surg,
  tp_med_medi,
  tp_med_path,
  tp_med_radi,
  tp_med_anes,
  tp_med_faci,
  tp_cnt_cnt,
  ingest_date = Sys.Date()
)]

bq_table_upload(x=procedure_dev_table, values= checkup_new_bq, create_disposition='CREATE_IF_NEEDED', write_disposition='WRITE_APPEND')

checkup_est <-  checkup_est[,`:=`(
  surg_sp_name_clean = surg_sp_npi %>% map_chr(get_npi_standard_name),
  surg_bp_name_clean = surg_bp_npi %>% map_chr(get_npi_standard_name),

  medi_sp_name_clean = medi_sp_npi %>% map_chr(get_npi_standard_name),
  medi_bp_name_clean = medi_bp_npi %>% map_chr(get_npi_standard_name),

  radi_sp_name_clean = radi_sp_npi %>% map_chr(get_npi_standard_name),
  radi_bp_name_clean = radi_bp_npi %>% map_chr(get_npi_standard_name),

  path_sp_name_clean = path_sp_npi %>% map_chr(get_npi_standard_name),
  path_bp_name_clean = path_bp_npi %>% map_chr(get_npi_standard_name),

  anes_sp_name_clean = anes_sp_npi %>% map_chr(get_npi_standard_name),
  anes_bp_name_clean = anes_bp_npi %>% map_chr(get_npi_standard_name),

  faci_sp_name_clean = faci_sp_npi %>% map_chr(get_npi_standard_name),
  faci_bp_name_clean = faci_bp_npi %>% map_chr(get_npi_standard_name)
                           )]

checkup_est_btb4 <- checkup_est %>% btbv4()

checkup_est_bq <- checkup_est_btb4 %>%
  .[,`:=`(procedure_type=10, procedure_modifier="Established Patient")] %>%
  .[is.na(doctor_str2)] %>%
  .[,.(
  primary_doctor = doctor_str1,
  primary_doctor_npi = doctor_npi_str1 ,
  most_important_fac	,
  most_important_fac_npi,
  procedure_type,
  procedure_modifier,
  tp_med_med,
  tp_med_surg,
  tp_med_medi,
  tp_med_path,
  tp_med_radi,
  tp_med_anes,
  tp_med_faci,
  tp_cnt_cnt,
  ingest_date = Sys.Date()
)]

bq_table_upload(x=procedure_dev_table, values= checkup_est_bq, create_disposition='CREATE_IF_NEEDED', write_disposition='WRITE_APPEND')