Module 1: Hospital Pricing and Selection on Observables

class: center, middle, inverse, title-slide

.title[
# Module 1: Hospital Pricing and Selection on Observables
]
.subtitle[
## Part 3: Hospital Prices and Penalties
]
.author[
### Ian McCarthy | Emory University
]
.date[
### Econ 470 & HLTH 470
]

---

<style type="text/css">
.remark-slide-content {
    font-size: 30px;
    padding: 1em 2em 1em 2em;    
}
.remark-code {
  font-size: 15px;
}
.remark-inline-code { 
    font-size: 20px;
}
</style>

# Penalized hospitals

```r
hcris.data <- read_rds(here("data/HCRIS_Data.rds"))

hcris.data <- hcris.data %>%
  mutate( discount_factor = 1-tot_discounts/tot_charges,
          price_num = (ip_charges + icu_charges + ancillary_charges)*discount_factor - tot_mcare_payment,
          price_denom = tot_discharges - mcare_discharges,
          price = price_num/price_denom)

final.hcris <- hcris.data %>% ungroup() %>%
  filter(price_denom>100, !is.na(price_denom), 
         price_num>0, !is.na(price_num),
         price<100000, 
*        beds>30, year==2012) %>%
  mutate( hvbp_payment = ifelse(is.na(hvbp_payment),0,hvbp_payment),
*         hrrp_payment = ifelse(is.na(hrrp_payment),0,abs(hrrp_payment)),
*   penalty = (hvbp_payment-hrrp_payment<0))
```

---
# Summary stats
Always important to look at your data before doing any formal analysis. Ask yourself a few questions:
1. Are the magnitudes reasonable?

2. Are there lots of missing values?

3. Are there clear examples of misreporting?

---
# Summary stats

.pull-left[

```r
summary(hcris.data$price)
```

```
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
## -123697    4783    7113     Inf   10230     Inf   63662
```

```r
plot(density(hcris.data$price, na.rm=TRUE))
```

<img src="01-hospital-pricing3_files/figure-html/unnamed-chunk-2-1.png" style="display: block; margin: auto;" />
]

.pull-right[

```r
summary(final.hcris$price)
```

```
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   340.8  6129.9  8705.4  9646.9 11905.4 97688.8
```

```r
plot(density(final.hcris$price))
```

<img src="01-hospital-pricing3_files/figure-html/unnamed-chunk-3-1.png" style="display: block; margin: auto;" />
]

---
# Dealing with problems
We've adopted a very brute force way to deal with outlier prices. Other approaches include:
1. Investigate very closely the hospitals with extreme values

2. Winsorize at certain thresholds (replace extreme values with pre-determined thresholds)

3. Impute prices for extreme hospitals

---
# Differences among penalized hospitals
- Mean price among penalized hospitals: 9,896.31
- Mean price among non-penalized hospitals: 9,560.41
- Mean difference: 335.9

---
# Comparison of hospitals
Are penalized hospitals sufficiently similar to non-penalized hospitals?

--
<br>
<br>
Let's look at covariate balance using a love plot, part of the `library(cobalt)` package.

---
# Love plots without adjustment

```r
love.plot(bal.tab(lp.covs,treat=lp.vars$penalty), colors="black", shapes="circle", threshold=0.1) + 
  theme_bw() + theme(legend.position="none")
```

.plot-callout[
<img src="01-hospital-pricing3_files/figure-html/cov-balance-callout-1.png" style="display: block; margin: auto;" />
]

---
# Love plots without adjustment

---
# Using matching to improve balance
Some things to think about:
- exact versus nearest neighbor
- with or without ties (and how to break ties)
- measure of distance

---
# 1. Exact Matching

```r
m.exact <- Matching::Match(Y=lp.vars$price,
                           Tr=lp.vars$penalty,
                           X=lp.covs,
                           M=1,
*                          exact=TRUE)
print(m.exact)
```

```
## [1] NA
## attr(,"class")
## [1] "Match"
```

---
# 1. Exact Matching (on a subset)

```r
lp.covs2 <- lp.covs %>% select(beds, mcaid_discharges)
m.exact <- Matching::Match(Y=lp.vars$price,
                           Tr=lp.vars$penalty,
                           X=lp.covs2,
                           M=1,
                           exact=TRUE,
*                          estimand="ATE")
```

---
# 1. Exact Matching (on a subset)

```r
love.plot(bal.tab(m.exact, covs = lp.covs2, treat = lp.vars$penalty),  
          threshold=0.1, 
          grid=FALSE, sample.names=c("Unmatched", "Matched"),
          position="top", shapes=c("circle","triangle"),
          colors=c("black","blue")) + 
  theme_bw()
```

.plot-callout[
<img src="01-hospital-pricing3_files/figure-html/lp-exact-callout-1.png" style="display: block; margin: auto;" />
]

---
# 1. Exact Matching (on a subset)