RDS 286: Case #6 Resource Allocation

## Settings for RMarkdown http://yihui.name/knitr/options#chunk_options
opts_chunk$set(comment = "", warning = FALSE, message = FALSE, echo = TRUE, 
    tidy = FALSE)
options(width = 116)

a. Suppose the agency has a budget of $50,000,000. Which of the programs should it fund? What are the total costs and total benefits attributable to each funded program?

This is a shopping spree problem. The table was ordered in the order of a small cost per life-year saved to a large cost per life-year, then the cumulative cost and cumulative life-years saved were calculated at each row.

case6 <- read.table(header = TRUE, text = "
Program LY.saved Cost
A 1000 10
B 400 6
C 100 4
D 200 9
E 1000 5
F 200 6
G 200 50
H 300 22.5
I 500 10
J 200 25
K 200 11
")

case6 <- within(case6, {
    Cost <- Cost * 1000000
    Cost.per.LY.saved <- Cost / LY.saved
})

case6 <- case6[order(case6$Cost.per.LY.saved),]
case6.orig <- case6

case6 <- within(case6, {
    cumul.LY.saved <- cumsum(LY.saved)
    cumul.cost <- formatC(cumsum(Cost), big.mark = ",", digits = 10)
    Cost <- formatC(Cost, big.mark = ",", digits = 10)
    Cost.per.LY.saved <- formatC(Cost.per.LY.saved, big.mark = ",", digits = 10)
})

case6
   Program LY.saved        Cost Cost.per.LY.saved  cumul.cost cumul.LY.saved
5        E     1000   5,000,000             5,000   5,000,000           1000
1        A     1000  10,000,000            10,000  15,000,000           2000
2        B      400   6,000,000            15,000  21,000,000           2400
9        I      500  10,000,000            20,000  31,000,000           2900
6        F      200   6,000,000            30,000  37,000,000           3100
3        C      100   4,000,000            40,000  41,000,000           3200
4        D      200   9,000,000            45,000  50,000,000           3400
11       K      200  11,000,000            55,000  61,000,000           3600
8        H      300  22,500,000            75,000  83,500,000           3900
10       J      200  25,000,000           125,000 108,500,000           4100
7        G      200  50,000,000           250,000 158,500,000           4300

Programs E, A, B, I, F, C, and D can be funded in this order. The total cost spent is 50,000,000, and total life years saved is 3400 life-years. The cost

Life-years saved and cost from these 7 programs are:

case6[1:7,c("Program","LY.saved","Cost")]
  Program LY.saved        Cost
5       E     1000   5,000,000
1       A     1000  10,000,000
2       B      400   6,000,000
9       I      500  10,000,000
6       F      200   6,000,000
3       C      100   4,000,000
4       D      200   9,000,000

b. After the agency has carried out this analysis, it is pointed out to them that they have failed to consider the possibility of a particular screening program. This program, M, can be carried out at any of four possible levels, depending on the sensitivity of the screening test used. The costs and benefits of each possible variation of Program M are as follows:

case6.b <- read.table(header = TRUE, text = "
Program LY.saved Cost
M1 20 250000
M2 30 750000
M3 40 2250000
M4 80 3750000
")

case6.b
  Program LY.saved    Cost
1      M1       20  250000
2      M2       30  750000
3      M3       40 2250000
4      M4       80 3750000

**Which variation, if any, of Program M should be undertaken if the agency’s budget is $50,000,000? (Remember that the money used to pay for Program M must come out of the same \( 50,000,000 used to fund the other programs.)** This is a competing choice problem, as only one of choices M1 - M4 can be implemented. The incremental cost and benefit was calculated for each level, then the incremental cost-effectiveness ratio ( \)\Delta C / \Delta E$) was calculated by dividing the change in the cost by the change in the benefit. Both of the benefit and cost increase at each level, thus there is no dominated program (less benefit and more cost than next one) that have to be removed first.

case6.b <- within(case6.b, {
    delta.LY.saved <- diff(c(0, LY.saved))
    delta.Cost <- diff(c(0, Cost))
    ICER <- delta.Cost / delta.LY.saved
})
case6.b
  Program LY.saved    Cost   ICER delta.Cost delta.LY.saved
1      M1       20  250000  12500     250000             20
2      M2       30  750000  50000     500000             10
3      M3       40 2250000 150000    1500000             10
4      M4       80 3750000  37500    1500000             40

ggplot(data = case6.b, aes(x = LY.saved, y = Cost, label = Program)) + geom_text()

plot of chunk unnamed-chunk-5

The ICER of the M3 level screening is higher than that of the M4 level screening, thus, it should be removed due to extended dominance. This is also evident from the graph. After removal, the table is now:

case6.b <- within(case6.b[-3,], {
    delta.LY.saved <- diff(c(0, LY.saved))
    delta.Cost     <- diff(c(0, Cost))
    ICER           <- delta.Cost / delta.LY.saved
})
case6.b
  Program LY.saved    Cost  ICER delta.Cost delta.LY.saved
1      M1       20  250000 12500     250000             20
2      M2       30  750000 50000     500000             10
4      M4       80 3750000 60000    3000000             50

This table can now be incorporated into the first table with other independent programs.

case6.icer <- within(case6.orig, {
    ICER              <- Cost.per.LY.saved
    Cost.per.LY.saved <-  NULL
})


case6.b.icer <- case6.b[,c("Program","LY.saved","Cost","ICER")]
case6.b.icer$Program <- factor(case6.b.icer$Program,
                               levels = c("M1","M2","M3","M4"),
                               labels = c("M1","M2-M1","M3","M4-M2"))

all.icer <- rbind(case6.icer, case6.b.icer)
all.icer <- all.icer[order(all.icer$ICER),]

within(all.icer, {
    cumul.cost <- cumsum(Cost)
    cumul.cost <- formatC(cumul.cost, big.mark = ",", digits = 10)
    Cost <- formatC(Cost, big.mark = ",", digits = 10)
})
   Program LY.saved        Cost   ICER  cumul.cost
5        E     1000   5,000,000   5000   5,000,000
1        A     1000  10,000,000  10000  15,000,000
12      M1       20     250,000  12500  15,250,000
2        B      400   6,000,000  15000  21,250,000
9        I      500  10,000,000  20000  31,250,000
6        F      200   6,000,000  30000  37,250,000
3        C      100   4,000,000  40000  41,250,000
4        D      200   9,000,000  45000  50,250,000
21   M2-M1       30     750,000  50000  51,000,000
11       K      200  11,000,000  55000  62,000,000
41   M4-M2       80   3,750,000  60000  65,750,000
8        H      300  22,500,000  75000  88,250,000
10       J      200  25,000,000 125000 113,250,000
7        G      200  50,000,000 250000 163,250,000

At the budget of $50,000,000, the screening program should be performed at the M1 level.

c.How would your answer to part (b) change if the agency’s budget were $15,000,000? $60,000,000? $100,000,000? $150,000,000?

Hint: In parts (b) and ( c), you do not need to calculate the total costs and benefits of each possible combination of programs. Use incremental cost-effectiveness ratios.

Budget
$ 15,000,000: No screening (programs E, A only)
$ 60,000,000: M2-level screening (programs E, A, M1, B, I, F, C, D, M2-M1, and part of K)
$100,000,000: M4-level screening (programs E, A, M1, B, I, F, C, D, M2-M1, K, M4-M2, H, part of J)
$150,000,000: M4-level screening (programs E, A, M1, B, I, F, C, D, M2-M1, K, M4-M2, H, J, part of G)