Power Analysis: PE vs BCBS Physician Wait Times

Background and Rationale

This document presents a power analysis for examining appointment wait time differences between private equity-owned (PE) physicians vs. physicians that primarily accept Blue Cross/Blue Shield (BCBS) insurance. Unlike the original Corbisiero et al. (2023) study, we’re exploring a scenario where PE-owned physicians have shorter wait times than BCBS-primary physicians.

Study Parameters

wait_time_pe <- 12.5
wait_time_bcbs <- 15.8

subspecialties <- c("General OB/GYN", "Urogynecology", "Gynecologic Oncology", 
                   "Reproductive Endocrinology", "Maternal-Fetal Medicine")

wait_time_pe_subspec <- c(10.2, 11.5, 9.8, 12.3, 10.0)
wait_time_bcbs_subspec <- c(14.0, 16.0, 15.0, 17.0, 14.5)

sd_between <- 6.0
sd_within <- 4.0
total_sd <- sqrt(sd_between^2 + sd_within^2)
logger::log_info("Total standard deviation: {round(total_sd, 2)} days")

alpha <- 0.05
power_target <- 0.80
dropout_rate <- 0.15

Expected Wait Times by Ownership Structure

ownership_wait_times <- data.frame(
  Ownership_Type = c("PE-Owned", "BCBS-Primary"),
  Mean_Wait_Days = c(wait_time_pe, wait_time_bcbs),
  Difference = c(NA, wait_time_pe - wait_time_bcbs)
)

knitr::kable(ownership_wait_times,
             caption = "Expected Wait Times (in Business Days) by Physician Ownership Type",
             col.names = c("Physician Type", "Mean Wait Time (Days)", "Difference from PE-Owned"),
             align = "lrr") %>%
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                            full_width = FALSE) %>%
  kableExtra::row_spec(2, bold = TRUE)

Expected Wait Times (in Business Days) by Physician Ownership Type

Physician Type	Mean Wait Time (Days)	Difference from PE-Owned
PE-Owned	12.5	NA
BCBS-Primary	15.8	-3.3

Expected Wait Times by Subspecialty and Ownership Type

subspecialty_wait_times <- data.frame(
  Subspecialty = subspecialties,
  PE_Wait = wait_time_pe_subspec,
  BCBS_Wait = wait_time_bcbs_subspec
) %>%
  mutate(
    Difference = BCBS_Wait - PE_Wait,
    Ratio = round(BCBS_Wait / PE_Wait, 2)
  )

knitr::kable(subspecialty_wait_times,
             caption = "Expected Wait Times (in Business Days) by OB/GYN Subspecialty and Ownership Type",
             col.names = c("Subspecialty", "PE Wait", "BCBS Wait", "Difference (BCBS - PE)", "Ratio (BCBS/PE)"),
             align = "lrrrr",
             digits = c(0, 1, 1, 1, 2)) %>%
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                            full_width = FALSE)

Expected Wait Times (in Business Days) by OB/GYN Subspecialty and Ownership Type

Subspecialty	PE Wait	BCBS Wait	Difference (BCBS - PE)	Ratio (BCBS/PE)
General OB/GYN	10.2	14.0	3.8	1.37
Urogynecology	11.5	16.0	4.5	1.39
Gynecologic Oncology	9.8	15.0	5.2	1.53
Reproductive Endocrinology	12.3	17.0	4.7	1.38
Maternal-Fetal Medicine	10.0	14.5	4.5	1.45

subspecialty_df <- data.frame(
  Subspecialty = rep(subspecialties, each = 2),
  Ownership = rep(c("PE-Owned", "BCBS-Primary"), times = length(subspecialties)),
  Wait_Days = c(rbind(wait_time_pe_subspec, wait_time_bcbs_subspec))
)

ggplot(subspecialty_df, aes(x = Subspecialty, y = Wait_Days, fill = Ownership)) +
  geom_bar(stat = "identity", position = position_dodge(width = 0.9), width = 0.8) +
  geom_text(aes(label = round(Wait_Days, 1)), position = position_dodge(width = 0.9), 
            vjust = -0.5, size = 3.5) +
  scale_fill_manual(values = c("PE-Owned" = "#28a745", "BCBS-Primary" = "#3366CC")) +
  labs(title = "Expected Wait Times by Subspecialty and Ownership Type",
       subtitle = "PE-Owned physicians shown with shorter wait times than BCBS-Primary",
       x = "Subspecialty",
       y = "Wait Time (Business Days)") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 10),
        axis.title = element_text(size = 14),
        plot.title = element_text(size = 16, face = "bold"),
        panel.grid.major.x = element_blank())

Effect Size Calculations and Sample Size Estimations

mean_diff_overall <- wait_time_bcbs - wait_time_pe
cohen_d_overall <- round(abs(mean_diff_overall / total_sd), 2)

ownership_effect_size <- data.frame(
  Comparison = "BCBS-Primary vs. PE-Owned",
  Mean_Difference = mean_diff_overall,
  Effect_Size = cohen_d_overall,
  Interpretation = ifelse(cohen_d_overall < 0.5, "Medium", "Large")
)

knitr::kable(ownership_effect_size,
             caption = "Effect Size Calculation for Ownership Comparison",
             col.names = c("Comparison", "Mean Difference (Days)", "Cohen's d", "Interpretation"),
             align = "lrrc",
             digits = c(0, 1, 2, 0)) %>%
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                            full_width = FALSE)

Effect Size Calculation for Ownership Comparison

Comparison	Mean Difference (Days)	Cohen’s d	Interpretation
BCBS-Primary vs. PE-Owned	3.3	0.46	Medium

Power Curve

effect_sizes_range <- seq(0.2, 1.6, by = 0.2)
sample_sizes_range <- seq(10, 50, by = 2)
power_grid <- expand.grid(effect_size = effect_sizes_range, sample_size = sample_sizes_range)

power_grid$power <- mapply(function(d, n) {
  pwr.t.test(d = d, n = n, sig.level = alpha, type = "two.sample")$power
}, power_grid$effect_size, power_grid$sample_size)

power_grid$label <- paste0("d = ", power_grid$effect_size, "   (", round(power_grid$effect_size * total_sd, 1), " days)")

ggplot(power_grid, aes(x = sample_size, y = power, color = label)) +
  geom_line(size = 1) +
  geom_hline(yintercept = power_target, linetype = "dashed", color = "red") +
  scale_color_viridis_d(name = "Effect Size\n(Cohen's d and Days)") +
  scale_x_continuous(breaks = seq(10, 50, by = 2)) +
  scale_y_continuous(limits = c(0.5, 1.0)) +
  labs(title = "Power Curve for Wait Time Comparison",
       x = "Sample Size (per group)",
       y = "Statistical Power",
       caption = "Red dashed line: target power (80%)") +
  theme_minimal()

Interactive Power Curve

library(plotly)

effect_sizes_range <- seq(0.2, 1.6, by = 0.2)
sample_sizes_range <- seq(10, 50, by = 2)
power_grid <- expand.grid(effect_size = effect_sizes_range, sample_size = sample_sizes_range)

power_grid$power <- mapply(function(d, n) {
  pwr::pwr.t.test(d = d, n = n, sig.level = alpha, type = "two.sample")$power
}, power_grid$effect_size, power_grid$sample_size)

power_grid$label <- paste0("d = ", power_grid$effect_size, "   (", round(power_grid$effect_size * total_sd, 1), " days)")

static_plot <- ggplot2::ggplot(power_grid, ggplot2::aes(x = sample_size, y = power, color = label)) +
  ggplot2::geom_line(size = 1) +
  ggplot2::geom_hline(yintercept = power_target, linetype = "dashed", color = "red") +
  ggplot2::scale_color_viridis_d(name = "Effect Size\n(Cohen's d and Days)") +
  ggplot2::scale_x_continuous(breaks = seq(10, 50, by = 2)) +
  ggplot2::scale_y_continuous(limits = c(0.5, 1.0)) +
  ggplot2::labs(
    title = "Interactive Power Curve for Wait Time Comparison",
    x = "Sample Size (per group)",
    y = "Statistical Power",
    caption = "Red dashed line: target power (80%)"
  ) +
  ggplot2::theme_minimal()

plotly::ggplotly(static_plot)

## Final Sample Size Determination

overall_power_analysis <- pwr.t.test(
  d = cohen_d_overall,
  sig.level = alpha,
  power = power_target,
  type = "two.sample",
  alternative = "two.sided"
)

n_per_group <- ceiling(overall_power_analysis$n)
total_required <- n_per_group * 2
adjusted_total <- ceiling(total_required / (1 - dropout_rate))

final_summary <- data.frame(
  Description = c(
    "Cohen's d",
    "Sample size per group (unadjusted)",
    "Total required (unadjusted)",
    "Dropout adjustment (15%)",
    "Total required (adjusted)"
  ),
  Value = c(
    cohen_d_overall,
    n_per_group,
    total_required,
    "15%",
    adjusted_total
  )
)

knitr::kable(final_summary,
             caption = "Final Sample Size Determination",
             col.names = c("Description", "Value"),
             align = "lc") %>%
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                            full_width = FALSE) %>%
  kableExtra::row_spec(2:5, bold = TRUE, background = "#e6f0ff")

Final Sample Size Determination

Description	Value
Cohen’s d	0.46
Sample size per group (unadjusted)	76
Total required (unadjusted)	152
Dropout adjustment (15%)	15%
Total required (adjusted)	179

Conclusion

cat("\nThis power analysis scenario explores reduced wait times for PE-owned physicians compared to BCBS-primary physicians. \n")

## 
## This power analysis scenario explores reduced wait times for PE-owned physicians compared to BCBS-primary physicians.

cat(paste0("With a Cohen's d of ", cohen_d_overall, ", the required sample size per group for 80% power is ", n_per_group, ".\n"))

## With a Cohen's d of 0.46, the required sample size per group for 80% power is 76.

cat(paste0("After accounting for a 15% dropout rate, the total sample size needed is ", adjusted_total, ".\n"))

## After accounting for a 15% dropout rate, the total sample size needed is 179.