http://en.opasnet.org/en-opwiki/api.php?action=feedcontributions&user=Mnud&feedformat=atomOpasnet - User contributions [en]2024-03-29T09:02:48ZUser contributionsMediaWiki 1.29.1http://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=35427Economic evaluation2015-04-14T15:42:02Z<p>Mnud: </p>
<hr />
<div>{{progression class|progression=Reviewed}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
A general approach to answer the question is based on the concept of incremental cost-effectiveness. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The general principle is explained below (see 'Rationale').<br />
<br />
The importance of alternative assumptions about protection against individual serotypes were assessed in a sensitivity analysis. Several 'modifications' for PCV10 and PCV13 were considered, regarding assumptions about the extent of indirect protection against serotypes<br />
3, 6A, 6A, and 19A. A detailed account of the sensitivity analysis is on page [[Cost_effectiveness_sensitivity|'''Cost_effectiveness_sensitivity''']]. These analyses included determining the difference in the QALYs gained under PCV10 and PCV13.<br />
<br />
In summary, if PCV13 does not induce population-level (i.e. indirect) effects on serotype 3, the difference between PCV10 and PCV13 in quality adjusted life years (QALYs) gained and medical costs are relatively minor. Different assumptions about the roles of 6A protection by PCV10 and 6C protection by PCV13 lead to different preferences, with minor absolute differences in QALYs with respect to the overall effectiveness (QALYs gained) due to PCV vaccination. <br />
<br />
Therefore, in view of the intrinsic uncertainties in the evaluation, PCV10 and PCV13 can be regarded as equally effective. This also means that incremental cost effectiveness ratios do not need to be calculated. <br />
<br />
== Evaluation tool ==<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. Note, that some of the ouput is irrelevant if the vaccine programme is cost saving (i.e, if savings in medical costs exceed vaccine programme cost).<br />
<br />
'''N.B.''' Some assumptions applied int the sensitivity analysis cannot be realised with the current version of the programme. In particular, there is currently no option to include direct protection only (i.e. vaccine efficacy for the vaccinated cohorts only) for individual serotypes. However, the sensitivity analyses show that the difference between 'direct protection only' and 'no protection at all' is usually not decisive for the overall effectiveness of conjugate vaccination. In other words, the most important assumptions concers indirect protection.<br />
<br />
<br><br />
* <big>'''<u>Instructions for user: Choose the desired vaccine compositions and their prices and then press "Run code".</u>'''<br />
<br />
The results of the cost-effectiveness analysis will be displayed on a separate tab. </big><br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
costsum <- Total_costs<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
if (FALSE){#!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
#if (!is.null(debug_plot)) plot3<br />
#if (!is.null(debug_plot)) plot2<br />
#if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty...<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
ipdtable <- oapply(VacIPD, VacIPD@output["Vaccine"], sum)@output<br />
colnames(ipdtable)[colnames(ipdtable) == "VacIPDResult"] <- "N_of_IPD_cases"<br />
<br />
oprint(<br />
ipdtable[order(match(ipdtable$Vaccine, qorder)),],<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top",<br />
digits = rep(0, ncol(ipdtable) + 1)<br />
) <br />
<br />
##############################<br />
## print health care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine = qorder,<br />
Medical_costs = result(health_care_costs)[match(qorder,health_care_costs@output$Vaccine)] * 1e-6,<br />
<br />
## this row was corrected by Markku Nurhonen (mnud) 14 April 2015<br />
## old version listed prices sometimes in wrong order: Vaccine_programme_cost = result(vacprice) * 1e-6,<br />
<br />
Vaccine_programme_cost = result(vacprice)[match(qorder,vacprice@output$Vaccine)] * 1e-6,<br />
Health_care_costs = result(costsum)[match(qorder,costsum@output$Vaccine)] * 1e-6<br />
)<br />
oprint(<br />
sum_table1A,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top",<br />
digits = c(0,0,2,2,2)<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(<br />
tekstia, <br />
include.rownames = FALSE, <br />
include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top"<br />
)<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained = QALYs_gained,<br />
Incremental_effect = QALYs_incremental,<br />
Health_care_costs = Cost_total * 1e-6,<br />
Incremental_cost = Cost_incremental * 1e-6,<br />
ICER = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top",<br />
digits = c(0,0,0,0,2,2,2)<br />
)<br />
</rcode><br />
<br />
<br />
== Rationale == <br />
<br />
{{method}}<br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER){{reslink|Economic comparison method}}:<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Data ===<br />
Summary table of the data applied in the cost-effectiveness analysis. Note, that the cost-effectiveness analysis is based on age-year (0-100) specific data on IPD and life years lost.<br />
<br />
1. QALY_menin = QALY losses due to meningitis incl. sequlae (in years, *)<br />
2. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
3. CFR = Case fatality ratio for meningitis and bacteremia<br />
4. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
5. Cost_ menin = Medical costs attributed to meningitis incl. sequlae (in euros *)<br />
6. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
7. Menin_proportion = Proportion of meningitis cases of all IPD cases<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
{| || {{prettytable}}<br />
|+Estimated medical costs and years lost due to a single bacteremia or meningitis episode <br />
| Age class || QALY_men || QALY_bac || CFR || Life_y_lost || COST_men || COST_bac || Menin_proportion<br />
|---<br />
| <5 years || 0.22 || 0.0079 || 0.014 || 31.1 || 22 070 || 1 986 || 0.037<br />
|---<br />
| 5-64 years || 0.16 || 0.0079 || 0.112 || 20.7 || 26 488 || 9 000 || 0.046<br />
|---<br />
| 65+ years || 0.08 || 0.0079 || 0.196 || 9.4 || 21 529 || 6 823 || 0.019<br />
|---<br />
|}<br />
* Note: The above table lists averages within each age class. Cost-effectiveness analysis is based on age year -specific values.<br />
<br />
<br><br />
<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost in Finland without vaccination (per year)<br />
|---<br />
|Age group||QALY_meningitis||QALY_bacteremia||Life_years_lost||Cost_meningitis||Cost_bacteremia<br />
|---<br />
|0-4y||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|5-64y||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|65+y||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
<br />
<br><br />
<br />
=== Computation ===<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Sensitivity ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-effectiveness analysis were assessed. Several modifications for PCV10 and PCV13 were considered. Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. '''For results, see''' [[Cost_effectiveness_sensitivity|'''Cost_effectiveness_sensitivity''']].<br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in quality adjusted life years (QALYs) gained and medical costs are relatively minor. Therefore, in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective.<br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Related files ==<br />
<br />
* {{#l:GSK 04 Economic evaluation_final_for Opasnet.docx}}<br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=35423Economic evaluation2015-04-14T11:38:30Z<p>Mnud: corrected Table2col3 order</p>
<hr />
<div>{{progression class|progression=Reviewed}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
A general approach to answer the question is based on the concept of incremental cost-effectiveness. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The general principle is explained below (see 'Rationale').<br />
<br />
The importance of alternative assumptions about protection against individual serotypes were assessed in a sensitivity analysis. Several 'modifications' for PCV10 and PCV13 were considered, regarding assumptions about the extent of indirect protection against serotypes<br />
3, 6A, 6A, and 19A. A detailed account of the sensitivity analysis is on page [[Cost_effectiveness_sensitivity|'''Cost_effectiveness_sensitivity''']]. These analyses included determining the difference in the QALYs gained under PCV10 and PCV13.<br />
<br />
In summary, if PCV13 does not induce population-level (i.e. indirect) effects on serotype 3, the difference between PCV10 and PCV13 in quality adjusted life years (QALYs) gained and medical costs are relatively minor. Different assumptions about the roles of 6A protection by PCV10 and 6C protection by PCV13 lead to different preferences, with minor absolute differences in QALYs with respect to the overall effectiveness (QALYs gained) due to PCV vaccination. <br />
<br />
Therefore, in view of the intrinsic uncertainties in the evaluation, PCV10 and PCV13 can be regarded as equally effective. This also means that incremental cost effectiveness ratios do not need to be calculated. <br />
<br />
== Evalution tool ==<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. Note, that some of the ouput is irrelevant if the vaccine programme is cost saving (i.e, if savings in medical costs exceed vaccine programme cost).<br />
<br />
'''N.B.''' Some assumptions applied int the sensitivity analysis cannot be realised with the current version of the programme. In particular, there is currently no option to include direct protection only (i.e. vaccine efficacy for the vaccinated cohorts only) for individual serotypes. However, the sensitivity analyses show that the difference between 'direct protection only' and 'no protection at all' is usually not decisive for the overall effectiveness of conjugate vaccination. In other words, the most important assumptions concers indirect protection.<br />
<br />
<br><br />
* <big>'''<u>Instructions for user: Choose the desired vaccine compositions and their prices and then press "Run code".</u>'''<br />
<br />
The results of the cost-effectiveness analysis will be displayed on a separate tab. </big><br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
costsum <- Total_costs<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
if (FALSE){#!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
#if (!is.null(debug_plot)) plot3<br />
#if (!is.null(debug_plot)) plot2<br />
#if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty...<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
ipdtable <- oapply(VacIPD, VacIPD@output["Vaccine"], sum)@output<br />
colnames(ipdtable)[colnames(ipdtable) == "VacIPDResult"] <- "N_of_IPD_cases"<br />
<br />
oprint(<br />
ipdtable[order(match(ipdtable$Vaccine, qorder)),],<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top",<br />
digits = rep(0, ncol(ipdtable) + 1)<br />
) <br />
<br />
##############################<br />
## print health care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine = qorder,<br />
Medical_costs = result(health_care_costs)[match(qorder,health_care_costs@output$Vaccine)] * 1e-6,<br />
<br />
## this row was corrected by Markku Nurhonen (mnud) 14 April 2015<br />
## old version listed prices sometimes in wrong order: Vaccine_programme_cost = result(vacprice) * 1e-6,<br />
<br />
Vaccine_programme_cost = result(vacprice)[match(qorder,vacprice@output$Vaccine)] * 1e-6,<br />
Health_care_costs = result(costsum)[match(qorder,costsum@output$Vaccine)] * 1e-6<br />
)<br />
oprint(<br />
sum_table1A,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top",<br />
digits = c(0,0,2,2,2)<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(<br />
tekstia, <br />
include.rownames = FALSE, <br />
include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top"<br />
)<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained = QALYs_gained,<br />
Incremental_effect = QALYs_incremental,<br />
Health_care_costs = Cost_total * 1e-6,<br />
Incremental_cost = Cost_incremental * 1e-6,<br />
ICER = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top",<br />
digits = c(0,0,0,0,2,2,2)<br />
)<br />
</rcode><br />
<br />
<br />
== Rationale == <br />
<br />
{{method}}<br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER){{reslink|Economic comparison method}}:<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Data ===<br />
Summary table of the data applied in the cost-effectiveness analysis. Note, that the cost-effectiveness analysis is based on age-year (0-100) specific data on IPD and life years lost.<br />
<br />
1. QALY_menin = QALY losses due to meningitis incl. sequlae (in years, *)<br />
2. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
3. CFR = Case fatality ratio for meningitis and bacteremia<br />
4. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
5. Cost_ menin = Medical costs attributed to meningitis incl. sequlae (in euros *)<br />
6. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
7. Menin_proportion = Proportion of meningitis cases of all IPD cases<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
{| || {{prettytable}}<br />
|+Estimated medical costs and years lost due to a single bacteremia or meningitis episode <br />
| Age class || QALY_men || QALY_bac || CFR || Life_y_lost || COST_men || COST_bac || Menin_proportion<br />
|---<br />
| <5 years || 0.22 || 0.0079 || 0.014 || 31.1 || 22 070 || 1 986 || 0.037<br />
|---<br />
| 5-64 years || 0.16 || 0.0079 || 0.112 || 20.7 || 26 488 || 9 000 || 0.046<br />
|---<br />
| 65+ years || 0.08 || 0.0079 || 0.196 || 9.4 || 21 529 || 6 823 || 0.019<br />
|---<br />
|}<br />
* Note: The above table lists averages within each age class. Cost-effectiveness analysis is based on age year -specific values.<br />
<br />
<br><br />
<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost in Finland without vaccination (per year)<br />
|---<br />
|Age group||QALY_meningitis||QALY_bacteremia||Life_years_lost||Cost_meningitis||Cost_bacteremia<br />
|---<br />
|0-4y||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|5-64y||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|65+y||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
<br />
<br><br />
<br />
=== Computation ===<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Sensitivity ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-effectiveness analysis were assessed. Several modifications for PCV10 and PCV13 were considered. Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. '''For results, see''' [[Cost_effectiveness_sensitivity|'''Cost_effectiveness_sensitivity''']].<br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in quality adjusted life years (QALYs) gained and medical costs are relatively minor. Therefore, in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective.<br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Related files ==<br />
<br />
* {{#l:GSK 04 Economic evaluation_final_for Opasnet.docx}}<br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33821Economic evaluation2014-09-15T06:48:59Z<p>Mnud: do not need to be calculated</p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
A general approach to answer the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The general principle is explained below (see 'Rationale').<br />
<br />
The importance of alternative assumptions about protection against individual serotypes were assessed in a sensitivity analysis. Several 'modifications' for PCV10 and PCV13 were considered, regarding assumptions about the extent of indirect protection against serotypes<br />
3, 6A, 6A, and 19A. A detailed account of the sensitivity analysis is on page [[Cost_effectiveness_sensitivity|'''Cost_effectiveness_sensitivity''']]. These analyses included determining the difference in the QALYs gained under PCV10 and PCV13.<br />
<br />
In summary, if PCV13 does not induce population-level (i.e. indirect) effects on serotype 3, the difference between PCV10 and PCV13 in quality adjusted life years (QALYs) gained and medical costs are relatively minor. Different assumptions about the roles of 6A protection by PCV10 and 6C protection by PCV13 lead to different preferences, with minor absolute differences in QALYs with respect to the overall effectiveness (QALYs gained) due to PCV vaccination. <br />
<br />
Therefore, in view of the intrinsic uncertainties in the evaluation, PCV10 and PCV13 can be regarded as equally effective. This also means that incremental cost effectiveness ratios do not need to be calculated. <br />
<br />
== Evalution tool ==<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. Note, that some of the ouput is irrelevant if the vaccine programme is cost saving (i.e, if savings in medical costs exceed vaccine programme cost).<br />
<br />
'''N.B.''' Some assumptions applied int the sensitivity analysis cannot be realised with the current version of the programme. In particular, there is currently no option to include direct protection only (i.e. vaccine efficacy for the vaccinated cohorts only) for individual serotypes. However, the sensitivity analyses show that the difference between 'direct protection only' and 'no protection at all' is usually not decisive for the overall effectiveness of conjugate vaccination. In other words, the most important assumptions concers indirect protection.<br />
<br />
<br><br />
* <big>'''<u>Instructions for user: Choose the desired vaccine compositions and their prices and then press "Run code".</u>'''<br />
<br />
The results of the cost-effectiveness analysis will be displayed on a separate tab. </big><br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
costsum <- Total_costs<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
if (FALSE){#!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
#if (!is.null(debug_plot)) plot3<br />
#if (!is.null(debug_plot)) plot2<br />
#if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty...<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
ipdtable <- oapply(VacIPD, VacIPD@output["Vaccine"], sum)@output<br />
colnames(ipdtable)[colnames(ipdtable) == "VacIPDResult"] <- "N_of_IPD_cases"<br />
<br />
oprint(<br />
ipdtable[order(match(ipdtable$Vaccine, qorder)),],<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top",<br />
digits = rep(0, ncol(ipdtable) + 1)<br />
) <br />
<br />
##############################<br />
## print health care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine = qorder,<br />
Medical_costs = result(health_care_costs)[match(qorder,health_care_costs@output$Vaccine)] * 1e-6,<br />
Vaccine_programme_cost = result(vacprice) * 1e-6,<br />
Health_care_costs = result(costsum)[match(qorder,costsum@output$Vaccine)] * 1e-6<br />
)<br />
oprint(<br />
sum_table1A,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top",<br />
digits = c(0,0,2,2,2)<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(<br />
tekstia, <br />
include.rownames = FALSE, <br />
include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top"<br />
)<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained = QALYs_gained,<br />
Incremental_effect = QALYs_incremental,<br />
Health_care_costs = Cost_total * 1e-6,<br />
Incremental_cost = Cost_incremental * 1e-6,<br />
ICER = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top",<br />
digits = c(0,0,0,0,2,2,2)<br />
)<br />
</rcode><br />
<br />
<br />
== Rationale == <br />
<br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER){{reslink|Economic comparison method}}:<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Data ===<br />
Summary table of the data applied in the cost-effectiveness analysis. Note, that the cost-effectiveness analysis is based on age-year (0-100) specific data on IPD and life years lost.<br />
<br />
1. QALY_menin = QALY losses due to meningitis incl. sequlae (in years, *)<br />
2. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
3. CFR = Case fatality ratio for meningitis and bacteremia<br />
4. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
5. Cost_ menin = Medical costs attributed to meningitis incl. sequlae (in euros *)<br />
6. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
7. Menin_proportion = Proportion of meningitis cases of all IPD cases<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
{| || {{prettytable}}<br />
|+Estimated medical costs and years lost due to a single bacteremia or meningitis episode <br />
| Age class || QALY_men || QALY_bac || CFR || Life_y_lost || COST_men || COST_bac || Menin_proportion<br />
|---<br />
| <5 years || 0.22 || 0.0079 || 0.014 || 31.1 || 22 070 || 1 986 || 0.037<br />
|---<br />
| 5-64 years || 0.16 || 0.0079 || 0.112 || 20.7 || 26 488 || 9 000 || 0.046<br />
|---<br />
| 65+ years || 0.08 || 0.0079 || 0.196 || 9.4 || 21 529 || 6 823 || 0.019<br />
|---<br />
|}<br />
* Note: The above table lists averages within each age class. Cost-effectiveness analysis is based on age year -specific values.<br />
<br />
<br><br />
<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost in Finland without vaccination (per year)<br />
|---<br />
|Age group||QALY_meningitis||QALY_bacteremia||Life_years_lost||Cost_meningitis||Cost_bacteremia<br />
|---<br />
|0-4y||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|5-64y||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|65+y||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
<br />
<br><br />
<br />
=== Computation ===<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Sensitivity ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Several modifications for PCV10 and PCV13 were considered. Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. '''For results, see''' [[Cost_effectiveness_sensitivity|'''Cost_effectiveness_sensitivity''']].<br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in quality adjusted life years (QALYs) gained and medical costs are relatively minor. Therefore, in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective.<br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Related files ==<br />
<br />
* {{#l:GSK 04 Economic evaluation_final_for Opasnet.docx}}<br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Cost_effectiveness_sensitivity&diff=33816Cost effectiveness sensitivity2014-09-14T10:35:23Z<p>Mnud: </p>
<hr />
<div>{{study|moderator=Jouni}}<br />
<br />
== Question ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-effectiveness analysis were assessed. Results are reported for PCV10 with modified effects for serotypes 19A and 6A and for PCV13 with modified effects for serotypes 3 and 6C.<br />
<br />
== Answer ==<br />
<br />
Conclusion: The assumption about serotype 3 in PCV13 is crucial. <br />
In addition, assumptions about the role of 6A in PCV10 is important. <br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in IPD, quality adjusted life years gained and medical costs are small (see Tables 1-7 in Section A below). Considering the magnitudes of these differences in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective. <br />
<br />
== Rationale ==<br />
<br><br />
Cost-effectiveness sensitivity analysis results are divided into sections A,B and C.<br />
<br><br />
==A.Vaccine effects on IPD, QALYs and costs by age group for alternative scenarios==<br />
<br><br />
<br />
'''Quantities tabulated:'''<br />
<br />
IPD = number of IPD cases per year in Finland<br />
IPD decrease = decrease in IPD due to the first mentioned vaccine<br />
<br />
QALYs lost = QALYs lost due to IPD per year in Finland, in years<br />
(QALYs related to IPD only)<br />
QALY = quality adjusted life year<br />
QALYs gained = QALYs gained due to the first mentioned vaccine<br />
<br />
Medical costs = Medical costs due to IPD per year in Finland in 1000 euros <br />
(costs related to IPD only)<br />
Medical savings = Difference in medical costs in 1000 euros per year <br />
in favor of the first mentioned vaccine<br />
<br />
'''Vaccine formulation considered:'''<br />
<br />
PCV10 includes the 10 serotypes in PCV10 and direct effects for serotypes 6A and 19A<br />
PCV10(6Af) includes the 10 serotypes in PCV10 amended <br />
by serotype 6A and direct effects (##) for 19A<br />
<br />
PCV13 includes 12 serotypes in PCV13, serotype 3 excluded. <br />
Assumes direct effects for serotypes 3 and 6C.<br />
PCV13(6Cf) includes 12 serotypes in PCV13, serotype 3 excluded <br />
and 6C added. Assumes direct effects for serotypes 3.<br />
<br />
<br><br />
'''Results''':<br />
<br><br />
* 1.No Vaccination<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD 330 26 124 236 302 1017<br />
QALYs lost 156 12 284 605 558 1615<br />
Medical costs (#) 918 70 1279 2431 2146 6843<br />
<br />
* 2.PCV10 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 225 15 49 30 45 362<br />
QALYs gained 105 7 102 76 86 376<br />
Medical savings(#) 608 37 504 306 320 1774<br />
<br />
* 3.PCV13 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 246 15 43 16 47 366<br />
QALYs gained 114 7 86 39 89 334<br />
Medical savings 656 38 443 160 335 1631<br />
<br />
* 4.PCV13 vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total <br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 21 0 -6 -14 2 4<br />
QALYs gained 9 0 -16 -37 3 -42<br />
Medical savings 48 1 -61 -146 15 -143<br />
<br />
* 5.PCV13(6Cf) vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65-100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 11 -1 -11 -29 -10 -40<br />
QALYs gained 4 -1 -29 -76 -21 -123<br />
Medical savings 17 -2 -116 -299 -74 -474<br />
<br />
* 6.PCV13 vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 31 2 1 6 14 54<br />
QALYs gained 15 1 1 13 28 57<br />
Medical savings 83 5 10 55 103 256<br />
<br />
* 7.PCV13(6Cf) vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 21 1 -4 -9 2 10<br />
QALYs gained 10 0 -12 -26 4 -24<br />
Medical savings 52 2 -45 -98 14 -75<br />
<br />
<br />
'''Interpretation''': <br />
<br><br />
Table 1 displays quantities when no vaccination is applied and Tables 2-3 display results for <br />
the default scenarios PCV10 and PCV13. The vaccines decrease QALYs and medical costs <br />
by approximately 20-25%. <br />
In comparison to these effets, the differences pertaining to pairwise comparisons of various <br />
versions of the vaccines (Tables 4-7) are small. Negative numbers in Tables 4-7 indicate <br />
situations favorable to PCV10.<br />
<br><br />
<br />
'''(*)'''= In the calculations above, the original observed/predicted number of IPD cases <br />
among under 3 year old children is multiplied 3.75. This adjustment was made to <br />
better reflect the actual disease incidence <br />
(reference: Palmu et al. (2014) Vaccine effectiveness of the pneumococcal.., <br />
The Lancet Resp. Med.Vol2,9,p.717-)<br />
<br />
'''(#)'''= costs and savings are given in 1000 euros<br />
<br />
'''(##)'''= a vaccine with "only direct effects" for a particular serotype means that, <br />
for vaccinated persons, vaccine efficacy against IPD caused by this serotype is 90% with <br />
a waning rate of 10% per year. In practise this means that approximately 70% of the <br />
serotype-specific IPD is eliminated among the <5 year olds. The implications of <br />
this modification to the results pertaining to the population as a whole <br />
are quite small and correspond closely to assuming no vaccine efficacy against <br />
the serotype in question.<br />
<br />
<br><br />
<br />
==B. Vaccine effects on IPD, QALYs and costs for alternative scenarios, summary==<br />
<br><br />
<br />
'''Quantities tabulated''': <br />
<br />
IPD decrease = decrease in IPD due to the vaccine appearing in <br />
the column label vs the vaccine appearing in the row<br />
QALYs gained = same for QALYS gained (QALYs related to IPD only)<br />
Medical savings = same for saving in medical costs (costs related to IPD only)<br />
<br />
'''Vaccine formulations considered''':<br />
<br />
PCV10(a) vaccine including all of the 10 serotypes<br />
PCV10 includes the 10 serotypes in PCV10 and direct effects for serotypes 6A and 19A<br />
PCV10(6Af) includes the 10 serotypes in PCV10 amended <br />
by serotype 6A and direct effects (##) for 19A<br />
<br />
PCV13(a) vaccine including all of the 13 serotypes, including serotype 3<br />
PCV13 includes 12 serotypes in PCV13, serotype 3 excluded. <br />
Assumes direct effects for serotypes 3 and 6C.<br />
PCV13(6Cf) includes 12 serotypes in PCV13, serotype 3 excluded <br />
and 6C added. Assumes direct effects for serotypes 3.<br />
<br />
<br><br />
'''Results''':<br />
<br><br />
IPD decrease <br />
------------ <br />
PCV13(a) PCV13 PCV13(6Cf) <br />
------ ----- ---------- <br />
PCV10(a) 227 95 50 <br />
PCV10 137 4 -40 <br />
PCV10(6Af) 187 54 10 <br />
<br />
QALYs gained <br />
------------ <br />
PCV13(a) PCV13 PCV13(6Cf) <br />
------ ----- ----------<br />
PCV10(a) 305 5 -79 <br />
PCV10 260 -42 -123 <br />
PCV10(6Af) 357 57 -24 <br />
<br />
Medical costs saved (in 1000 euros) <br />
-------------------<br />
PCV13(a) PCV13 PCV13(6Cf) <br />
------ ----- ----------<br />
PCV10(a) 1294 125 -215 <br />
PCV10 1035 -143 -474 <br />
PCV10(6Af) 1425 256 -75 <br />
<br />
<br />
'''Interpretation''':<br />
<br><br />
These are summaries of Tables 4-7 in Section A now also<br />
including "full" 10- and 13- valent versions of the vaccines.<br />
The crucial effect of inclusion of serotype 3 in PCV13<br />
is clear. <br />
<br />
<br><br />
<br />
==C. Acceptable price level under alternative scenarios for PCV13 when price of PCV10 set at 20 and 30==<br />
<br />
<br><br />
<br />
'''Quantities tabulated and vaccine formulations considered''':<br />
<br />
<br><br />
Column and row labels as in tables as in Section B. The entries <br />
are prices acceptable for PCV13 when PCV10 price is 10 or 20. <br />
Any price below the given value is acceptable for PCV13. <br />
<br><br />
<br />
In addition, the incremental cost effectiveness ratio (ICER)is given. <br />
This is the ICER either when the more effective vaccine is <br />
compared to the other or when the less effective is compared to <br />
the "no vaccination" scenario. It corresponds to the average <br />
price of a QALY gain when either of the vaccines is chosen <br />
assuming the indicated price level. <br />
<br />
<br><br />
<br />
'''Results''':<br />
<br><br />
<br />
Max price for PCV13 when price of PCV10 = 20 <br />
--------------------------------------------<br />
<br />
PCV13(a) PCV13 PCV13(6Cf) ICER(#)<br />
------ ----- ---------- ----<br />
PCV10(a) 38 21 16 6.27 <br />
PCV10 33 18 14 4.85 <br />
PCV10(6Af) 44 24 18 7.92 <br />
<br />
<br />
<br />
Max price for PCV13 when price of PCV10 = 30<br />
--------------------------------------------<br />
<br />
PCV13(a) PCV13 PCV13(6Cf) ICER(#) <br />
------ ----- ---------- ----<br />
PCV10(a) 57 31 24 11.6 <br />
PCV10 50 27 21 9.63 <br />
PCV10(6Af) 66 36 27 14.3 <br />
<br />
<br />
'''Note''':<br />
<br><br />
(#)= in 1000 euros<br />
<br><br />
<br />
These tables are calculated taking into account benefits<br />
related to IPD only. If other disease entities are taken into<br />
accoount, the vaccines may well be cost saving (in terms of<br />
total health care costs) and these tables are to be<br />
interpreted with caution. Nevertheless, they indicate<br />
that if serotype 3 is not included in PCV13, then the<br />
differences between the vaccines are much smaller and,<br />
depending on assumptions, may be in favor of either<br />
one of the vaccines.<br />
<br />
<br><br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Cost_effectiveness_sensitivity&diff=33815Cost effectiveness sensitivity2014-09-14T09:30:11Z<p>Mnud: </p>
<hr />
<div>{{study|moderator=Jouni}}<br />
<br />
== Question ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-effectiveness analysis were assessed. Results are reported for PCV10 with modified effects for serotypes 19A and 6A and for PCV13 with modified effects for serotypes 3 and 6C.<br />
<br />
== Answer ==<br />
<br />
Conclusion: The assumption about serotype 3 in PCV13 is crucial. <br />
In addition, assumptions about the role of 6A in PCV10 is important. <br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in IPD, quality adjusted life years gained and medical costs are small (see Tables 1-7 in Section A below). Considering the magnitudes of these differences in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective. <br />
<br />
== Rationale ==<br />
<br><br />
Cost-effectiveness sensitivity analysis results are divided into sections A,B and C.<br />
<br><br />
==A.Vaccine effects on IPD, QALYs and costs by age group for alternative scenarios==<br />
<br><br />
<br />
'''Quantities tabulated:'''<br />
<br />
IPD = number of IPD cases per year in Finland<br />
IPD decrease = decrease in IPD due to the first mentioned vaccine<br />
<br />
QALYs lost = QALYs lost due to IPD per year in Finland, in years<br />
(QALYs related to IPD only)<br />
QALY = quality adjusted life year<br />
QALYs gained = QALYs gained due to the first mentioned vaccine<br />
<br />
Medical costs = Medical costs due to IPD per year in Finland in 1000 euros <br />
(costs related to IPD only)<br />
Medical savings = Difference in medical costs in 1000 euros per year <br />
in favor of the first mentioned vaccine<br />
<br />
'''Vaccine formulation considered:'''<br />
<br />
PCV10 includes the 10 serotypes in PCV10 and direct effects for serotypes 6A and 19A<br />
PCV10(6Af) includes the 10 serotypes in PCV10 amended <br />
by serotype 6A and direct effects (##) for 19A<br />
<br />
PCV13 includes 12 serotypes in PCV13, serotype 3 excluded. <br />
Assumes direct effects for serotypes 3 and 6C.<br />
PCV13(6Cf) includes 12 serotypes in PCV13, serotype 3 excluded <br />
and 6C added. Assumes direct effects for serotypes 3.<br />
<br />
<br><br />
'''Results''':<br />
<br><br />
* 1.No Vaccination<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD 330 26 124 236 302 1017<br />
QALYs lost 156 12 284 605 558 1615<br />
Medical costs (#) 918 70 1279 2431 2146 6843<br />
<br />
* 2.PCV10 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 225 15 49 30 45 362<br />
QALYs gained 105 7 102 76 86 376<br />
Medical savings(#) 608 37 504 306 320 1774<br />
<br />
* 3.PCV13 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 246 15 43 16 47 366<br />
QALYs gained 114 7 86 39 89 334<br />
Medical savings 656 38 443 160 335 1631<br />
<br />
* 4.PCV13 vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total <br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 21 0 -6 -14 2 4<br />
QALYs gained 9 0 -16 -37 3 -42<br />
Medical savings 48 1 -61 -146 15 -143<br />
<br />
* 5.PCV13(6Cf) vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65-100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 11 -1 -11 -29 -10 -40<br />
QALYs gained 4 -1 -29 -76 -21 -123<br />
Medical savings 17 -2 -116 -299 -74 -474<br />
<br />
* 6.PCV13 vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 31 2 1 6 14 54<br />
QALYs gained 15 1 1 13 28 57<br />
Medical savings 83 5 10 55 103 256<br />
<br />
* 7.PCV13(6Cf) vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 21 1 -4 -9 2 10<br />
QALYs gained 10 0 -12 -26 4 -24<br />
Medical savings 52 2 -45 -98 14 -75<br />
<br />
<br />
'''Interpretation''': <br />
<br><br />
Table 1 displays quantities when no vaccination is applied and Tables 2-3 display results for <br />
the default scenarios PCV10 and PCV13. The vaccines decrease QALYs and medical costs <br />
by approximately 20-25%. <br />
In comparison to these effets, the differences pertaining to pairwise comparisons of various <br />
versions of the vaccines (Tables 4-7) are small. Negative numbers in Tables 4-7 indicate <br />
situations favorable to PCV10.<br />
<br><br />
<br />
'''(*)'''= In the calculations above, the original observed/predicted number of IPD cases <br />
among under 3 year old children is multiplied 3.75. This adjustment was made to <br />
better reflect the actual disease incidence <br />
(reference: Palmu et al. (2014) Vaccine effectiveness of the pneumococcal.., <br />
The Lancet Resp. Med.Vol2,9,p.717-)<br />
<br />
'''(#)'''= costs and savings are given in 1000 euros<br />
<br />
'''(##)'''= a vaccine with "only direct effects" for a particular serotype means that, <br />
for vaccinated persons, vaccine efficacy against IPD caused by this serotype is 90% with <br />
a waning rate of 10% per year. In practise this means that approximately 70% of the <br />
serotype-specific IPD is eliminated among the <5 year olds. The implications of <br />
this modification to the results pertaining to the population as a whole <br />
are quite small and correspond closely to assuming no vaccine efficacy against <br />
the serotype in question.<br />
<br />
<br><br />
<br />
==B. Vaccine effects on IPD, QALYs and costs for alternative scenarios, summary==<br />
<br><br />
<br />
'''Quantities tabulated''': <br />
<br />
IPD decrease = decrease in IPD due to the vaccine appearing in <br />
the column label vs the vaccine appearing in the row<br />
QALYs gained = same for QALYS gained (QALYs related to IPD only)<br />
Medical savings = same for saving in medical costs (costs related to IPD only)<br />
<br />
'''Vaccine formulations considered''':<br />
<br />
PCV10(a) vaccine including all of the 10 serotypes<br />
PCV10 includes the 10 serotypes in PCV10 and direct effects for serotypes 6A and 19A<br />
PCV10(6Af) includes the 10 serotypes in PCV10 amended <br />
by serotype 6A and direct effects (##) for 19A<br />
<br />
PCV13(a) vaccine including all of the 13 serotypes, including serotype 3<br />
PCV13 includes 12 serotypes in PCV13, serotype 3 excluded. <br />
Assumes direct effects for serotypes 3 and 6C.<br />
PCV13(6Cf) includes 12 serotypes in PCV13, serotype 3 excluded <br />
and 6C added. Assumes direct effects for serotypes 3.<br />
<br />
<br><br />
'''Results''':<br />
<br><br />
IPD decrease <br />
------------ <br />
PCV13(a) PCV13 PCV13(6Cf) <br />
------ ----- ---------- <br />
PCV10(a) 227 95 50 <br />
PCV10 137 4 -40 <br />
PCV10(6Af) 187 54 10 <br />
<br />
QALYs gained <br />
------------ <br />
PCV13(a) PCV13 PCV13(6Cf) <br />
------ ----- ----------<br />
PCV10(a) 305 5 -79 <br />
PCV10 260 -42 -123 <br />
PCV10(6Af) 357 57 -24 <br />
<br />
Medical costs saved (in 1000 euros) <br />
-------------------<br />
PCV13(a) PCV13 PCV13(6Cf) <br />
------ ----- ----------<br />
PCV10(a) 1294 125 -215 <br />
PCV10 1035 -143 -474 <br />
PCV10(6Af) 1425 256 -75 <br />
<br />
<br />
'''Interpretation''':<br />
<br><br />
These are summaries of Tables 4-7 in Section A now also<br />
including "full" 10- and 13- valent versions of the vaccines.<br />
The crucial effect of inclusion of serotype 3 in PCV13<br />
is clear. <br />
<br />
<br><br />
<br />
==C. Acceptable price level under alternative scenarios for PCV13 when price of PCV10 set at 20 and 30==<br />
<br />
<br><br />
<br />
'''Quantities tabulated and vaccine formulations considered''':<br />
<br />
<br><br />
Column and row labels as in tables as in Section B. The entries <br />
are prices acceptable for PCV13 when PCV10 price is 10 or 20. <br />
Any price below the given value is acceptable for PCV13. <br />
<br><br />
<br />
In addition, the incremental cost effectiveness ratio (ICER)is given. <br />
This is the ICER either when the more effective vaccine is <br />
compared to the other or when the less effective is compared to <br />
the "no vaccination" scenario. It corresponds to the average <br />
price of a QALY gain when either of the vaccines is chosen <br />
assuming the indicated price level. <br />
<br />
<br><br />
<br />
'''Results''':<br />
<br><br />
<br />
Max price for PCV13 when price of PCV10 = 20 <br />
--------------------------------------------<br />
<br />
PCV13(a) PCV13 PCV13(6Cf) ICER(#)<br />
------ ----- ---------- ----<br />
PCV10(a) 38 21 16 6.27 <br />
PCV10 33 18 14 4.85 <br />
PCV10(6Af) 44 24 18 7.92 <br />
<br />
<br />
<br />
Max price for PCV13 when price of PCV10 = 30<br />
--------------------------------------------<br />
<br />
PCV13(a) PCV13 PCV13(6Cf) ICER(#) <br />
------ ----- ---------- ----<br />
PCV10(a) 57 31 24 11.6 <br />
PCV10 50 27 21 9.63 <br />
PCV10(6Af) 66 36 27 14.3 <br />
<br />
<br />
'''Note''':<br />
<br><br />
(#)= in 1000 euros<br />
<br><br />
<br />
These tables are calculated taking into account benefits<br />
related to IPD only. If other disease entities are taken into<br />
accoount, the vaccines may well be cost saving (in terms of<br />
total health care costs) and these tables are should be<br />
interpreted with great caution. Nevertheless, they indicate<br />
that if serotype 3 is not included in PCV13, then the<br />
differences between the vaccines are much smaller and,<br />
depending on assumptions, may be in favor of either<br />
one of the vaccines.<br />
<br />
<br><br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Cost_effectiveness_sensitivity&diff=33814Cost effectiveness sensitivity2014-09-14T09:27:50Z<p>Mnud: </p>
<hr />
<div>{{study|moderator=Jouni}}<br />
<br />
== Question ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-effectiveness analysis were assessed. Results are reported for PCV10 with modified effects for serotypes 19A and 6A and for PCV13 with modified effects for serotypes 3 and 6C.<br />
<br />
== Answer ==<br />
<br />
Conclusion: The assumption about serotype 3 in PCV13 is crucial. <br />
In addition, assumptions about the role of 6A in PCV10 is important. <br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in IPD, quality adjusted life years gained and medical costs are small (see Tables 1-7 in Section A below). Considering the magnitudes of these differences in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective. <br />
<br />
== Rationale ==<br />
<br><br />
Cost-effectiveness sensitivity analysis results are divided into sections A,B and C.<br />
<br><br />
==A.Vaccine effects on IPD, QALYs and costs by age group for alternative scenarios==<br />
<br><br />
<br />
'''Quantities tabulated:'''<br />
<br />
IPD = number of IPD cases per year in Finland<br />
IPD decrease = decrease in IPD due to the first mentioned vaccine<br />
<br />
QALYs lost = QALYs lost due to IPD per year in Finland, in years<br />
(QALYs related to IPD only)<br />
QALY = quality adjusted life year<br />
QALYs gained = QALYs gained due to the first mentioned vaccine<br />
<br />
Medical costs = Medical costs due to IPD per year in Finland in 1000 euros <br />
(costs related to IPD only)<br />
Medical savings = Difference in medical costs in 1000 euros per year <br />
in favor of the first mentioned vaccine<br />
<br />
'''Vaccine formulation considered:'''<br />
<br />
PCV10 includes the 10 serotypes in PCV10 and direct effects for serotypes 6A and 19A<br />
PCV10(6Af) includes the 10 serotypes in PCV10 amended <br />
by serotype 6A and direct effects (##) for 19A<br />
<br />
PCV13 includes 12 serotypes in PCV13, serotype 3 excluded. <br />
Assumes direct effects for serotypes 3 and 6C.<br />
PCV13(6Cf) includes 12 serotypes in PCV13, serotype 3 excluded <br />
and 6C added. Assumes direct effects for serotypes 3.<br />
<br />
<br><br />
'''Results''':<br />
<br><br />
* 1.No Vaccination<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD 330 26 124 236 302 1017<br />
QALYs lost 156 12 284 605 558 1615<br />
Medical costs (#) 918 70 1279 2431 2146 6843<br />
<br />
* 2.PCV10 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 225 15 49 30 45 362<br />
QALYs gained 105 7 102 76 86 376<br />
Medical savings(#) 608 37 504 306 320 1774<br />
<br />
* 3.PCV13 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 246 15 43 16 47 366<br />
QALYs gained 114 7 86 39 89 334<br />
Medical savings 656 38 443 160 335 1631<br />
<br />
* 4.PCV13 vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total <br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 21 0 -6 -14 2 4<br />
QALYs gained 9 0 -16 -37 3 -42<br />
Medical savings 48 1 -61 -146 15 -143<br />
<br />
* 5.PCV13(6Cf) vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65-100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 11 -1 -11 -29 -10 -40<br />
QALYs gained 4 -1 -29 -76 -21 -123<br />
Medical savings 17 -2 -116 -299 -74 -474<br />
<br />
* 6.PCV13 vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 31 2 1 6 14 54<br />
QALYs gained 15 1 1 13 28 57<br />
Medical savings 83 5 10 55 103 256<br />
<br />
* 7.PCV13(6Cf) vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 21 1 -4 -9 2 10<br />
QALYs gained 10 0 -12 -26 4 -24<br />
Medical savings 52 2 -45 -98 14 -75<br />
<br />
<br />
'''Interpretation''': <br />
<br><br />
Table 1 displays quantities when no vaccination is applied and Tables 2-3 display results for <br />
the default scenarios PCV10 and PCV13. The vaccines decrease QALYs and medical costs <br />
by approximately 20-25%. <br />
In comparison to these effets, the differences pertaining to pairwise comparisons of various <br />
versions of the vaccines (Tables 4-7) are small. Negative numbers in Tables 4-7 indicate <br />
situations favorable to PCV10.<br />
<br><br />
<br />
'''(*)'''= In the calculations above, the original observed/predicted number of IPD cases <br />
among under 3 year old children is multiplied 3.75. This adjustment was made to <br />
better reflect the actual disease incidence <br />
(reference: Palmu et al. (2014) Vaccine effectiveness of the pneumococcal.., <br />
The Lancet Resp. Med.Vol2,9,p.717-)<br />
<br />
'''(#)'''= costs and savings are given in 1000 euros<br />
<br />
'''(##)'''= a vaccine with "only direct effects" for a particular serotype means that, <br />
for vaccinated persons, vaccine efficacy against IPD caused by this serotype is 90% with <br />
a waning rate of 10% per year. In practise this means that approximately 70% of the <br />
serotype-specific IPD is eliminated among the <5 year olds. The implications of <br />
this modification to the results pertaining to the population as a whole <br />
are quite small and correspond closely to assuming no vaccine efficacy against <br />
the serotype in question.<br />
<br />
<br><br />
<br />
==B. Vaccine effects on IPD, QALYs and costs for alternative scenarios, summary==<br />
<br><br />
<br />
'''Quantities tabulated''': <br />
<br />
IPD decrease = decrease in IPD due to the vaccine appearing in <br />
the column label vs the vaccine appearing in the row<br />
QALYs gained = same for QALYS gained (QALYs related to IPD only)<br />
Medical savings = same for saving in medical costs (costs related to IPD only)<br />
<br />
'''Vaccine formulations considered''':<br />
<br />
PCV10(a) vaccine including all of the 10 serotypes<br />
PCV10 includes the 10 serotypes in PCV10 and direct effects for serotypes 6A and 19A<br />
PCV10(6Af) includes the 10 serotypes in PCV10 amended <br />
by serotype 6A and direct effects (##) for 19A<br />
<br />
PCV13(a) vaccine including all of the 13 serotypes, including serotype 3<br />
PCV13 includes 12 serotypes in PCV13, serotype 3 excluded. <br />
Assumes direct effects for serotypes 3 and 6C.<br />
PCV13(6Cf) includes 12 serotypes in PCV13, serotype 3 excluded <br />
and 6C added. Assumes direct effects for serotypes 3.<br />
<br />
<br><br />
'''Results''':<br />
<br><br />
IPD decrease <br />
------------ <br />
PCV13(a) PCV13 PCV13(6Cf) <br />
------ ----- ---------- <br />
PCV10(a) 227 95 50 <br />
PCV10 137 4 -40 <br />
PCV10(6Af) 187 54 10 <br />
<br />
QALYs gained <br />
------------ <br />
PCV13(a) PCV13 PCV13(6Cf) <br />
------ ----- ----------<br />
PCV10(a) 305 5 -79 <br />
PCV10 260 -42 -123 <br />
PCV10(6Af) 357 57 -24 <br />
<br />
Medical costs saved (in 1000 euros) <br />
-------------------<br />
PCV13(a) PCV13 PCV13(6Cf) <br />
------ ----- ----------<br />
PCV10(a) 1294 125 -215 <br />
PCV10 1035 -143 -474 <br />
PCV10(6Af) 1425 256 -75 <br />
<br />
<br />
'''Interpretation''':<br />
<br><br />
These are summaries of Tables 4-7 in Section A now also<br />
including "full" 10- and 13- valent versions of the vaccines.<br />
The crucial effect of inclusion of serotype 3 in PCV13<br />
is clear. <br />
<br />
<br><br />
<br />
==C. Acceptable price level under alternative scenarios for PCV13 when price of PCV10 set at 20 and 30==<br />
<br />
<br><br />
<br />
'''Quantities tabulated and vaccine formulations considered''':<br />
<br />
<br><br />
Column and row labels as in tables as in Section B. The entries <br />
are prices acceptable for PCV13 when PCV10 price is 10 or 20. <br />
Any price below the given value is acceptable for PCV13. <br />
<br><br />
<br />
In addition, the incremental cost effectiveness ratio (ICER)is given. <br />
This is the ICER either when the more effective vaccine is <br />
compared to the other or when the less effective is compared to <br />
the "no vaccination" scenario. It corresponds to the average <br />
price of a QALY gain when either of the vaccines is chosen <br />
assuming the indicated price level. <br />
<br />
<br><br />
<br />
'''Results''':<br />
<br><br />
<br />
Max price for PCV13 when PCV10 = 20 <br />
-----------------------------------<br />
<br />
PCV13(a) PCV13 PCV13(6Cf) ICER(#)<br />
------ ----- ---------- ----<br />
PCV10(a) 38 21 16 6.27 <br />
PCV10 33 18 14 4.85 <br />
PCV10(6Af) 44 24 18 7.92 <br />
<br />
<br />
<br />
Max price for PCV13 when PCV10 = 30<br />
-----------------------------------<br />
<br />
PCV13(a) PCV13 PCV13(6Cf) ICER(#) <br />
------ ----- ---------- ----<br />
PCV10(a) 57 31 24 11.6 <br />
PCV10 50 27 21 9.63 <br />
PCV10(6Af) 66 36 27 14.3 <br />
<br />
<br />
'''Note''':<br />
<br><br />
(#)= in 1000 euros<br />
<br><br />
<br />
These tables are calculated taking into account benefits<br />
related to IPD only. If other disease entities are taken into<br />
accoount, the vaccines may well be cost saving (in terms of<br />
total health care costs) and these tables are should be<br />
interpreted with great caution. Nevertheless, they indicate<br />
that if serotype 3 is not included in PCV13, then the<br />
differences between the vaccines are much smaller and,<br />
depending on assumptions, may be in favor of either<br />
one of the vaccines.<br />
<br />
<br><br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Cost_effectiveness_sensitivity&diff=33812Cost effectiveness sensitivity2014-09-14T09:00:39Z<p>Mnud: </p>
<hr />
<div>{{study|moderator=Jouni}}<br />
<br />
== Question ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-effectiveness analysis were assessed. Results are reported for PCV10 with modified effects for serotypes 19A and 6A and for PCV13 with modified effects for serotypes 3 and 6C.<br />
<br />
== Answer ==<br />
<br />
Conclusion: The assumption about serotype 3 in PCV13 is crucial. <br />
In addition, assumptions about the role of 6A in PCV10 is important. <br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in IPD, quality adjusted life years gained and medical costs are small (see Tables 1-7 in Section A below). Considering the magnitudes of these differences in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective. <br />
<br />
== Rationale ==<br />
<br><br />
Cost-effectiveness sensitivity analysis results are divided into sections A,B and C.<br />
<br><br />
==A.Vaccine effects on IPD, QALYs and costs by age group for alternative scenarios==<br />
<br><br />
<br />
'''Quantities tabulated:'''<br />
<br />
IPD = number of IPD cases per year in Finland<br />
IPD decrease = decrease in IPD due to the first mentioned vaccine<br />
<br />
QALYs lost = QALYs lost due to IPD per year in Finland, in years<br />
(QALYs related to IPD only)<br />
QALY = quality adjusted life year<br />
QALYs gained = QALYs gained due to the first mentioned vaccine<br />
<br />
Medical costs = Medical costs due to IPD per year in Finland in 1000 euros <br />
(costs related to IPD only)<br />
Medical savings = Difference in medical costs in 1000 euros per year <br />
in favor of the first mentioned vaccine<br />
<br />
'''Vaccine formulation considered:'''<br />
<br />
PCV10 includes the 10 serotypes in PCV10 and direct effects for serotypes 6A and 19A<br />
PCV10(6Af) includes the 10 serotypes in PCV10 amended <br />
by serotype 6A and direct effects (##) for 19A<br />
<br />
PCV13 includes 12 serotypes in PCV13, serotype 3 excluded. <br />
Assumes direct effects for serotypes 3 and 6C.<br />
PCV13(6Cf) includes 12 serotypes in PCV13, serotype 3 excluded <br />
and 6C added. Assumes direct effects for serotypes 3.<br />
<br />
<br><br />
'''Results''':<br />
<br><br />
* 1.No Vaccination<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD 330 26 124 236 302 1017<br />
QALYs lost 156 12 284 605 558 1615<br />
Medical costs (#) 918 70 1279 2431 2146 6843<br />
<br />
* 2.PCV10 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 225 15 49 30 45 362<br />
QALYs gained 105 7 102 76 86 376<br />
Medical savings(#) 608 37 504 306 320 1774<br />
<br />
* 3.PCV13 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 246 15 43 16 47 366<br />
QALYs gained 114 7 86 39 89 334<br />
Medical savings 656 38 443 160 335 1631<br />
<br />
* 4.PCV13 vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total <br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 21 0 -6 -14 2 4<br />
QALYs gained 9 0 -16 -37 3 -42<br />
Medical savings 48 1 -61 -146 15 -143<br />
<br />
* 5.PCV13(6Cf) vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65-100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 11 -1 -11 -29 -10 -40<br />
QALYs gained 4 -1 -29 -76 -21 -123<br />
Medical savings 17 -2 -116 -299 -74 -474<br />
<br />
* 6.PCV13 vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 31 2 1 6 14 54<br />
QALYs gained 15 1 1 13 28 57<br />
Medical savings 83 5 10 55 103 256<br />
<br />
* 7.PCV13(6Cf) vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 21 1 -4 -9 2 10<br />
QALYs gained 10 0 -12 -26 4 -24<br />
Medical savings 52 2 -45 -98 14 -75<br />
<br />
<br />
'''Interpretation''': <br />
<br><br />
Table 1 displays quantities when no vaccination is applied and Tables 2-3 display results for <br />
the default scenarios PCV10 and PCV13. The vaccines decrease QALYs and medical costs <br />
by approximately 20-25%. <br />
In comparison to these effets, the differences pertaining to pairwise comparisons of various <br />
versions of the vaccines (Tables 4-7) are small. Negative numbers in Tables 4-7 indicate <br />
situations favorable to PCV10.<br />
<br><br />
<br />
'''(*)'''= In the calculations above, the original observed/predicted number of IPD cases <br />
among under 3 year old children is multiplied 3.75. This adjustment was made to <br />
better reflect the actual disease incidence <br />
(reference: Palmu et al. (2014) Vaccine effectiveness of the pneumococcal.., <br />
The Lancet Resp. Med.Vol2,9,p.717-)<br />
<br />
'''(#)'''= costs and savings are given in 1000 euros<br />
<br />
'''(##)'''= a vaccine with "only direct effects" for a particular serotype means that, <br />
for vaccinated persons, vaccine efficacy against IPD caused by this serotype is 90% with <br />
a waning rate of 10% per year. In practise this means that approximately 70% of the <br />
serotype-specific IPD is eliminated among the <5 year olds. The implications of <br />
this modification to the results pertaining to the population as a whole <br />
are quite small and correspond closely to assuming no vaccine efficacy against <br />
the serotype in question.<br />
<br />
<br><br />
<br />
==B. Vaccine effects on IPD, QALYs and costs for alternative scenarios, summary==<br />
<br><br />
<br />
'''Quantities tabulated''': <br />
<br />
IPD decrease = decrease in IPD due to the vaccine appearing in <br />
the column label vs the vaccine appearing in the row<br />
QALYs gained = same for QALYS gained (QALYs related to IPD only)<br />
Medical savings = same for saving in medical costs (costs related to IPD only)<br />
<br />
'''Vaccine formulations considered''':<br />
<br />
PCV10(a) vaccine including all of the 10 serotypes<br />
PCV10 includes the 10 serotypes in PCV10 and direct effects for serotypes 6A and 19A<br />
PCV10(6Af) includes the 10 serotypes in PCV10 amended <br />
by serotype 6A and direct effects (##) for 19A<br />
<br />
PCV13(a) vaccine including all of the 13 serotypes, including serotype 3<br />
PCV13 includes 12 serotypes in PCV13, serotype 3 excluded. <br />
Assumes direct effects for serotypes 3 and 6C.<br />
PCV13(6Cf) includes 12 serotypes in PCV13, serotype 3 excluded <br />
and 6C added. Assumes direct effects for serotypes 3.<br />
<br />
<br><br />
'''Results''':<br />
<br><br />
IPD decrease <br />
------------ <br />
PCV13(a) PCV13 PCV13(6Cf) <br />
------ ----- ---------- <br />
PCV10(a) 227 95 50 <br />
PCV10 137 4 -40 <br />
PCV10(6Af) 187 54 10 <br />
<br />
QALYs gained <br />
------------ <br />
PCV13(a) PCV13 PCV13(6Cf) <br />
------ ----- ----------<br />
PCV10(a) 305 5 -79 <br />
PCV10 260 -42 -123 <br />
PCV10(6Af) 357 57 -24 <br />
<br />
Medical costs saved (in 1000 euros) <br />
-------------------<br />
PCV13(a) PCV13 PCV13(6Cf) <br />
------ ----- ----------<br />
PCV10(a) 1294 125 -215 <br />
PCV10 1035 -143 -474 <br />
PCV10(6Af) 1425 256 -75 <br />
<br />
<br />
'''Interpretation''':<br />
<br><br />
These are summaries of Tables 4-7 in Section A now also<br />
including "full" 10- and 13- valent versions of the vaccines.<br />
The crucial effect of inclusion of serotype 3 in PCV13<br />
is clear. <br />
<br />
<br><br />
<br />
==C. Acceptable price level under alternative scenarios for PCV13 when price of PCV10 set at 20 and 30==<br />
<br />
<br><br />
<br />
'''Quantities tabulated and vaccine formulations considered''':<br />
<br />
<br><br />
Column and row labels as in tables as in Section B. The entries <br />
are prices acceptable for PCV13 when PCV10 price is 10 or 20. <br />
Any price below the given value is acceptable for PCV13. <br />
<br><br />
<br />
In addition, the incremental cost effectiveness ratio (ICER)is given. <br />
This is the ICER either when the more effective vaccine is <br />
compared to the other or when the less effective is compared to <br />
the "no vaccination" scenario. It corresponds to the average <br />
price of a QALY gain when either of the vaccines is chosen <br />
assuming the indicated price level. <br />
<br />
<br><br />
<br />
'''Results''':<br />
<br><br />
<br />
Max price for PCV13 when PCV10 = 20 <br />
-----------------------------------<br />
<br />
PCV13(a) PCV13 PCV13(6Cf) ICER(#)<br />
------ ----- ---------- ----<br />
PCV10(a) 38 21 16 6.27 <br />
PCV10 33 18 14 4.85 <br />
PCV10(6Af) 44 24 18 7.92 <br />
<br />
<br />
<br />
Max price for PCV13 when PCV10 = 30<br />
-----------------------------------<br />
<br />
PCV13(a) PCV13 PCV13(6Cf) ICER(#) <br />
------ ----- ---------- ----<br />
PCV10(a) 57 31 24 1.16 <br />
PCV10 50 27 21 9.63 <br />
PCV10(6Af) 66 36 27 1.43 <br />
<br />
<br />
'''Note''':<br />
<br><br />
(#)= in 1000 euros<br />
<br><br />
<br />
These tables are calculated taking into account benefits<br />
related to IPD only. If other disease entities are taken into<br />
accoount, the vaccines may well be cost saving (in terms of<br />
total health care costs) and these tables are should be<br />
interpreted with great caution. Nevertheless, they indicate<br />
that if serotype 3 is not included in PCV13, then the<br />
differences between the vaccines are much smaller and,<br />
depending on assumptions, may be in favor of either<br />
one of the vaccines.<br />
<br />
<br><br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Cost_effectiveness_sensitivity&diff=33811Cost effectiveness sensitivity2014-09-14T08:52:42Z<p>Mnud: Sensitivity analysis results (Major update)</p>
<hr />
<div>{{study|moderator=Jouni}}<br />
<br />
== Question ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-effectiveness analysis were assessed. Results are reported for PCV10 with modified effects for serotypes 19A and 6A and for PCV13 with modified effects for serotypes 3 and 6C.<br />
<br />
== Answer ==<br />
<br />
Conclusion: The assumption about serotype 3 in PCV13 is crucial. <br />
In addition, assumptions about the role of 6A in PCV10 is important. <br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in IPD, quality adjusted life years gained and medical costs are small (see Tables 1-7 in Section A below). Considering the magnitudes of these differences in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective. <br />
<br />
== Rationale ==<br />
<br><br />
Cost-effectiveness sensitivity analysis results are divided into sections A,B and C.<br />
<br><br />
==A.Vaccine effects on IPD, QALYs and costs by age group for alternative scenarios==<br />
<br><br />
<br />
'''Quantities tabulated:'''<br />
<br />
IPD = number of IPD cases per year in Finland<br />
IPD decrease = decrease in IPD due to the first mentioned vaccine<br />
<br />
QALYs lost = QALYs lost due to IPD per year in Finland, in years<br />
(QALYs related to IPD only)<br />
QALY = quality adjusted life year<br />
QALYs gained = QALYs gained due to the first mentioned vaccine<br />
<br />
Medical costs = Medical costs due to IPD per year in Finland in 1000 euros <br />
(costs related to IPD only)<br />
Medical savings = Difference in medical costs in 1000 euros per year <br />
in favor of the first mentioned vaccine<br />
<br />
'''Vaccine formulation considered:'''<br />
<br />
PCV10 includes the 10 serotypes in PCV10 and direct effects for serotypes 6A and 19A<br />
PCV10(6Af) includes the 10 serotypes in PCV10 amended <br />
by serotype 6A and direct effects (##) for 19A<br />
<br />
PCV13 includes 12 serotypes in PCV13, serotype 3 excluded. <br />
Assumes direct effects for serotypes 3 and 6C.<br />
PCV13(6Cf) includes 12 serotypes in PCV13, serotype 3 excluded <br />
and 6C added. Assumes direct effects for serotypes 3.<br />
<br />
<br><br />
'''Results''':<br />
<br><br />
* 1.No Vaccination<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD 330 26 124 236 302 1017<br />
QALYs lost 156 12 284 605 558 1615<br />
Medical costs (#) 918 70 1279 2431 2146 6843<br />
<br />
* 2.PCV10 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 225 15 49 30 45 362<br />
QALYs gained 105 7 102 76 86 376<br />
Medical savings(#) 608 37 504 306 320 1774<br />
<br />
* 3.PCV13 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 246 15 43 16 47 366<br />
QALYs gained 114 7 86 39 89 334<br />
Medical savings 656 38 443 160 335 1631<br />
<br />
* 4.PCV13 vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total <br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 21 0 -6 -14 2 4<br />
QALYs gained 9 0 -16 -37 3 -42<br />
Medical savings 48 1 -61 -146 15 -143<br />
<br />
* 5.PCV13(6Cf) vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65-100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 11 -1 -11 -29 -10 -40<br />
QALYs gained 4 -1 -29 -76 -21 -123<br />
Medical savings 17 -2 -116 -299 -74 -474<br />
<br />
* 6.PCV13 vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 31 2 1 6 14 54<br />
QALYs gained 15 1 1 13 28 57<br />
Medical savings 83 5 10 55 103 256<br />
<br />
* 7.PCV13(6Cf) vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 21 1 -4 -9 2 10<br />
QALYs gained 10 0 -12 -26 4 -24<br />
Medical savings 52 2 -45 -98 14 -75<br />
<br />
<br />
'''Interpretation''': <br />
<br><br />
Table 1 displays quantities when no vaccination is applied and Tables 2-3 display results for <br />
the default scenarios PCV10 and PCV13. The vaccines decrease QALYs and medical costs <br />
by approximately 20-25%. <br />
In comparison to these effets, the differences pertaining to pairwise comparisons of various <br />
versions of the vaccines (Tables 4-7) are small. Negative numbers in Tables 4-7 indicate <br />
situations favorable to PCV10.<br />
<br><br />
<br />
'''(*)'''= In the calculations above, the original observed/predicted number of IPD cases <br />
among under 3 year old children is multiplied 3.75. This adjustment was made to <br />
better reflect the actual disease incidence <br />
(reference: Palmu et al. (2014) Vaccine effectiveness of the pneumococcal.., <br />
The Lancet Resp. Med.Vol2,9,p.717-)<br />
<br />
'''(#)'''= costs and savings are given in 1000 euros<br />
<br />
'''(##)'''= a vaccine with "only direct effects" for a particular serotype means that, <br />
for vaccinated persons, vaccine efficacy against IPD caused by this serotype is 90% with <br />
a waning rate of 10% per year. In practise this means that approximately 70% of the <br />
serotype-specific IPD is eliminated among the <5 year olds. The implications of <br />
this modification to the results pertaining to the population as a whole <br />
are quite small and correspond closely to assuming no vaccine efficacy against <br />
the serotype in question.<br />
<br />
<br><br />
<br />
==B. Vaccine effects on IPD, QALYs and costs for alternative scenarios, summary==<br />
<br><br />
<br />
'''Quantities tabulated''': <br />
<br />
IPD decrease = decrease in IPD due to the vaccine appearing in <br />
the column label vs the vaccine appearing in the row<br />
QALYs gained = same for QALYS gained (QALYs related to IPD only)<br />
Medical savings = same for saving in medical costs (costs related to IPD only)<br />
<br />
'''Vaccine formulations considered''':<br />
<br />
PCV10(a) vaccine including all of the 10 serotypes<br />
PCV10 includes the 10 serotypes in PCV10 and direct effects for serotypes 6A and 19A<br />
PCV10(6Af) includes the 10 serotypes in PCV10 amended <br />
by serotype 6A and direct effects (##) for 19A<br />
<br />
PCV13(a) vaccine including all of the 13 serotypes, including serotype 3<br />
PCV13 includes 12 serotypes in PCV13, serotype 3 excluded. <br />
Assumes direct effects for serotypes 3 and 6C.<br />
PCV13(6Cf) includes 12 serotypes in PCV13, serotype 3 excluded <br />
and 6C added. Assumes direct effects for serotypes 3.<br />
<br />
<br><br />
'''Results''':<br />
<br><br />
IPD decrease <br />
------------ <br />
PCV13(a) PCV13 PCV13(6Cf) <br />
------ ----- ---------- <br />
PCV10(a) 227 95 50 <br />
PCV10 137 4 -40 <br />
PCV10(6Af) 187 54 10 <br />
<br />
QALYs gained <br />
------------ <br />
PCV13(a) PCV13 PCV13(6Cf) <br />
------ ----- ----------<br />
PCV10(a) 305 5 -79 <br />
PCV10 260 -42 -123 <br />
PCV10(6Af) 357 57 -24 <br />
<br />
Medical costs saved <br />
-------------------<br />
PCV13(a) PCV13 PCV13(6Cf) <br />
------ ----- ----------<br />
PCV10(a) 1294 125 -215 <br />
PCV10 1035 -143 -474 <br />
PCV10(6Af) 1425 256 -75 <br />
<br />
<br />
'''Interpretation''':<br />
<br><br />
These are summaries of Tables 4-7 in Section A now also<br />
including "full" 10- and 13- valent versions of the vaccines.<br />
The crucial effect of inclusion of serotype 3 in PCV13<br />
is clear. <br />
<br />
<br><br />
<br />
==C. Acceptable price level under alternative scenarios for PCV13 when price of PCV10 set at 20 and 30==<br />
<br />
<br><br />
<br />
'''Quantities tabulated and vaccine formulations considered''':<br />
<br />
<br><br />
Column and row labels as in tables as in Section B. The entries <br />
are prices acceptable for PCV13 when PCV10 price is 10 or 20. <br />
Any price below the given value is acceptable for PCV13. <br />
<br><br />
<br />
In addition, the incremental cost effectiveness ratio (ICER)is given. <br />
This is the ICER either when the more effective vaccine is <br />
compared to the other or when the less effective is compared to <br />
the "no vaccination" scenario. It corresponds to the average <br />
price of a QALY gain when either of the vaccines is chosen <br />
assuming the indicated price level. <br />
<br />
<br><br />
<br />
'''Results''':<br />
<br><br />
<br />
Max price for PCV13 when PCV10 = 20 <br />
-----------------------------------<br />
<br />
PCV13(a) PCV13 PCV13(6Cf) ICER<br />
------ ----- ---------- ----<br />
PCV10(a) 38 21 16 6276 <br />
PCV10 33 18 14 4852 <br />
PCV10(6Af) 44 24 18 7923 <br />
<br />
<br />
<br />
Max price for PCV13 when PCV10 = 30<br />
-----------------------------------<br />
<br />
PCV13(a) PCV13 PCV13(6Cf) ICER <br />
------ ----- ---------- -----<br />
PCV10(a) 57 31 24 11695 <br />
PCV10 50 27 21 9634 <br />
PCV10(6Af) 66 36 27 14357 <br />
<br />
<br />
'''Note''':<br />
<br><br />
These tables are calculated taking into account benefits<br />
related to IPD only. If other disease entities are taken into<br />
accoount, the vaccines may well be cost saving (in terms of<br />
total health care costs) and these tables are should be<br />
interpreted with great caution. Nevertheless, they indicate<br />
that if serotype 3 is not included in PCV13, then the<br />
differences between the vaccines are much smaller and,<br />
depending on assumptions, may be in favor of either<br />
one of the vaccines.<br />
<br />
<br><br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Template:Pneumococcal_vaccine&diff=33810Template:Pneumococcal vaccine2014-09-13T16:54:53Z<p>Mnud: </p>
<hr />
<div>[[Category:Vaccine]]<br />
[[Category:Pneumococcus]]<br />
{| {{prettytable}}<br />
|+'''[[Tendering process for pneumococcal conjugate vaccine]]<br />
|----<br />
| Parts of the assessment<br />
| <br />
[[Comparison criteria|Comparison criteria for vaccine]] &#160; &middot;<br />
[[Epidemiological modelling]] &#160; &middot; <br />
[[Economic evaluation]]<br />
|----<br />
| Background information<br />
| <br />
[[Cost_effectiveness_sensitivity|Sensitivity analysis]] &middot;<br />
[[Replacement]] &#160; &middot; <br />
[[Pneumococcal vaccine products]] &#160; &middot; <br />
[[Finnish vaccination schedule]] &#160; &middot; <br />
[[References|Selected recent publications]] <br />
<br><br />
----------------<br />
Help for [[discussion]] and [[Help:Quick reference for wiki editing|wiki editing]]<br />
|----<br />
| Pages in Finnish<br />
| <br />
[[:op_fi:Pneumokokkirokotteen hankinta kansalliseen rokotusohjelmaan|Pneumokokkirokotteen hankinta]]&#160; &middot;<br />
[[:op_fi:Vertailuperusteet|Rokotteen vertailuperusteet]] &middot;<br />
[[:op_fi:Epidemiologinen malli|Epidemiologinen malli]] &middot;<br />
[[:op_fi:Taloudellinen arviointi|Taloudellinen arviointi]] &middot;<br />
[[:op_fi:Pneumokokkirokotteen turvallisuus|Pneumokokkirokotteen turvallisuus]]<br />
<br><br />
----------------<br />
[[:op_fi:Keskustelu:Pneumokokkirokotteen hankinta kansalliseen rokotusohjelmaan#Työn_osat|Work scheduling]] &middot;<br />
[[:op_fi:Pneumokokkikonjugaattirokotteen vaikuttavuuden seuranta|Monitoring the effectiveness of the pneumococcal conjugate vaccine]] &middot;<br />
[[:op_fi:Rokotesanasto|Glossary of vaccine terminology]]<br />
|}<br />
<br />
<noinclude>[[op_fi:Malline:Pneumokokkirokote]]<noinclude/></div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33809Economic evaluation2014-09-13T16:48:17Z<p>Mnud: </p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. Note, that some of the ouput is irrelevant if the vaccine programme is cost saving (i.e, if savings in medical costs exceed vaccine programme cost).<br />
<br />
<br><br />
* <big>'''<u>Instructions for user: Choose the desired vaccine compositions and their prices and then press "Run code".</u>'''<br />
<br />
The results of the cost-effectiveness analysis will be displayed on a separate tab. </big><br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
costsum <- Total_costs<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
if (FALSE){#!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
#if (!is.null(debug_plot)) plot3<br />
#if (!is.null(debug_plot)) plot2<br />
#if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty...<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
ipdtable <- oapply(VacIPD, VacIPD@output["Vaccine"], sum)@output<br />
colnames(ipdtable)[colnames(ipdtable) == "VacIPDResult"] <- "N_of_IPD_cases"<br />
<br />
oprint(<br />
ipdtable[order(match(ipdtable$Vaccine, qorder)),],<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top",<br />
digits = rep(0, ncol(ipdtable) + 1)<br />
) <br />
<br />
##############################<br />
## print health care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine = qorder,<br />
Medical_costs = result(health_care_costs)[match(qorder,health_care_costs@output$Vaccine)] * 1e-6,<br />
Vaccine_programme_cost = result(vacprice) * 1e-6,<br />
Health_care_costs = result(costsum)[match(qorder,costsum@output$Vaccine)] * 1e-6<br />
)<br />
oprint(<br />
sum_table1A,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top",<br />
digits = c(0,0,2,2,2)<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(<br />
tekstia, <br />
include.rownames = FALSE, <br />
include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top"<br />
)<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained = QALYs_gained,<br />
Incremental_effect = QALYs_incremental,<br />
Health_care_costs = Cost_total * 1e-6,<br />
Incremental_cost = Cost_incremental * 1e-6,<br />
ICER = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top",<br />
digits = c(0,0,0,0,2,2,2)<br />
)<br />
</rcode><br />
<br />
<br />
== Rationale == <br />
<br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER){{reslink|Economic comparison method}}:<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Data ===<br />
Summary table of the data applied in the cost-effectiveness analysis. Note, that the cost-effectiveness analysis is based on age-year (0-100) specific data on IPD and life years lost.<br />
<br />
1. QALY_menin = QALY losses due to meningitis incl. sequlae (in years, *)<br />
2. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
3. CFR = Case fatality ratio for meningitis and bacteremia<br />
4. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
5. Cost_ menin = Medical costs attributed to meningitis incl. sequlae (in euros *)<br />
6. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
7. Menin_proportion = Proportion of meningitis cases of all IPD cases<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
{| || {{prettytable}}<br />
|+Estimated medical costs and years lost due to a single bacteremia or meningitis episode <br />
| Age class || QALY_men || QALY_bac || CFR || Life_y_lost || COST_men || COST_bac || Menin_proportion<br />
|---<br />
| <5 years || 0.22 || 0.0079 || 0.014 || 31.1 || 22 070 || 1 986 || 0.037<br />
|---<br />
| 5-64 years || 0.16 || 0.0079 || 0.112 || 20.7 || 26 488 || 9 000 || 0.046<br />
|---<br />
| 65+ years || 0.08 || 0.0079 || 0.196 || 9.4 || 21 529 || 6 823 || 0.019<br />
|---<br />
|}<br />
* Note: The above table lists averages within each age class. Cost-effectiveness analysis is based on age year -specific values.<br />
<br />
<br><br />
<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost in Finland without vaccination (per year)<br />
|---<br />
|Age group||QALY_meningitis||QALY_bacteremia||Life_years_lost||Cost_meningitis||Cost_bacteremia<br />
|---<br />
|0-4y||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|5-64y||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|65+y||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
<br />
<br><br />
<br />
=== Computation ===<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Sensitivity ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Several modifications for PCV10 and PCV13 were considered. Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. '''For results, see''' [[Cost_effectiveness_sensitivity|'''Cost_effectiveness_sensitivity''']].<br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in quality adjusted life years (QALYs) gained and medical costs are relatively minor. Therefore, in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective.<br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Related files ==<br />
<br />
* {{#l:GSK 04 Economic evaluation_final_for Opasnet.docx}}<br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Cost_effectiveness_sensitivity&diff=33808Cost effectiveness sensitivity2014-09-13T16:45:55Z<p>Mnud: </p>
<hr />
<div>{{study|moderator=Jouni}}<br />
<br />
== Question ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-effectiveness analysis were assessed. Results are reported for PCV10 with modified effects for serotypes 19A and 6A and for PCV13 with modified effects for serotypes 3 and 6C.<br />
<br />
== Answer ==<br />
<br />
Conclusion: The assumption about serotype 3 in PCV13 is crucial. <br />
In addition, assumptions about the role of 6A in PCV10 is important. <br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in IPD, quality adjusted life years gained and medical costs are small (see Tables 1-7 in Section 1 below). Considering the magnitudes of these differences in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective. <br />
<br />
== Rationale ==<br />
<br><br />
<br />
==1.Vaccine effects on IPD, QALYs and costs by age group for alternative scenarios==<br />
<br><br />
<br />
Quantities tabulated:<br />
<br />
IPD = number of IPD cases per year in Finland<br />
IPD decrease = decrease in IPD due to the first mentioned vaccine<br />
<br />
QALYs lost = QALYs lost due to IPD per year in Finland, in years<br />
QALY=quality adjusted life year<br />
QALYs gained = QALYs gained due to the first mentioned vaccine<br />
<br />
Medical costs = Medical costs due to IPD per year in Finland in 1000 euros <br />
Medical savings = Difference in medical costs in 1000 euros per year <br />
in favor of the first mentioned vaccine<br />
<br />
Vaccine formulation considered:<br />
<br />
PCV10 includes the 10 serotypes in PCV10 and direct effects for serotypes 6A and 19A<br />
PCV10(6Af) includes the 10 serotypes in PCV10 amended <br />
by serotype 6A and direct effects (##) for 19A<br />
<br />
PCV13 includes 12 serotypes in PCV13, serotype 3 excluded. <br />
Assumes direct effects for serotypes 3 and 6C.<br />
PCV13(6Cf) includes 12 serotypes in PCV13, serotype 3 excluded <br />
and 6C added. Assumes direct effects for serotypes 3.<br />
<br />
* 1.No Vaccination<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD 330 26 124 236 302 1017<br />
QALYs lost 156 12 284 605 558 1615<br />
Medical costs (#) 918 70 1279 2431 2146 6843<br />
<br />
* 2.PCV10 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 225 15 49 30 45 362<br />
QALYs gained 105 7 102 76 86 376<br />
Medical savings(#) 608 37 504 306 320 1774<br />
<br />
* 3.PCV13 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 246 15 43 16 47 366<br />
QALYs gained 114 7 86 39 89 334<br />
Medical savings 656 38 443 160 335 1631<br />
<br />
* 4.PCV13 vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total <br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 21 0 -6 -14 2 4<br />
QALYs gained 9 0 -16 -37 3 -42<br />
Medical savings 48 1 -61 -146 15 -143<br />
<br />
* 5.PCV13(6Cf) vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65-100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 11 -1 -11 -29 -10 -40<br />
QALYs gained 4 -1 -29 -76 -21 -123<br />
Medical savings 17 -2 -116 -299 -74 -474<br />
<br />
* 6.PCV13 vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 31 2 1 6 14 54<br />
QALYs gained 15 1 1 13 28 57<br />
Medical savings 83 5 10 55 103 256<br />
<br />
* 7.PCV13(6Cf) vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 21 1 -4 -9 2 10<br />
QALYs gained 10 0 -12 -26 4 -24<br />
Medical savings 52 2 -45 -98 14 -75<br />
<br />
<br />
Interpretation <br />
-------<br />
Table 1 displays quantities when no vaccination is applied and Tables 2-3 display results for <br />
the default scenarios PCV10 and PCV13. The vaccines decrease QALYs and medical costs <br />
by approximately 20-25%. <br />
In comparison to these effets, the differences pertaining to pairwise comparisons of various <br />
versions of the vaccines (Tables 4-7) are small. Negative numbers in Tables 4-7 indicate <br />
situations favorable to PCV10.<br />
<br />
(*)= In the calculations above, the original observed/predicted number of IPD cases <br />
among under 3 year old children is multiplied 3.75. This adjustment was made to <br />
better reflect the actual disease incidence <br />
(reference: Palmu et al. (2014) Vaccine effectiveness of the pneumococcal..,<br />
The Lancet Resp. Med.Vol2,9,p.717-)<br />
<br />
(#)= costs and savings are given in 1000 euros<br />
<br />
(##)= a vaccine with "only direct effects" for a particular serotype means that, <br />
for vaccinated persons, vaccine efficacy against IPD caused by this serotype is 90% with<br />
a waning rate of 10% per year. In practise this means that approximately 70% of the <br />
serotype-specific IPD is eliminated among the <5 year olds. The implications of<br />
this modification to the results pertaining to the population as a whole<br />
are quite small and correspond closely to assuming no vaccine efficacy against <br />
the serotype in question.<br />
<br />
<br />
<br />
<br><br />
<br />
==2. Acceptable price level under alternative scenarios for PCV13 when price of PCV10 set at 20 and 30==<br />
<br><br />
<br />
This table is currently under revision (to synchronize it with tables 1-7 in Section 1 above) <br />
and will be restored by noon, 13 Sept 2014.<br />
<br />
<br><br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Cost_effectiveness_sensitivity&diff=33807Cost effectiveness sensitivity2014-09-13T12:02:52Z<p>Mnud: </p>
<hr />
<div>{{study|moderator=Jouni}}<br />
<br />
== Question ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-effectiveness analysis were assessed. Results are reported for PCV10 with modified effects for serotypes 19A and 6A and for PCV13 with modified effects for serotypes 3 and 6C.<br />
<br />
== Answer ==<br />
<br />
Conclusion: The assumption about serotype 3 in PCV13 is crucial. <br />
In addition, assumptions about the role of 6A in PCV10 is important. <br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in IPD, quality adjusted life years gained and medical costs are small (see Tables 1-7 in Section 1 below). Considering the magnitudes of these differences in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective. <br />
<br />
== Rationale ==<br />
<br><br />
<br />
==1.Vaccine effects on IPD, QALYs and costs by age group for alternative scenarios==<br />
<br><br />
<br />
Quantities tabulated:<br />
<br />
IPD = number of IPD cases per year in Finland<br />
IPD decrease = decrease in IPD due to the first mentioned vaccine<br />
<br />
QALYs lost = QALYs lost due to IPD per year in Finland, in years<br />
QALY=quality adjusted life year<br />
QALYs gained = QALYs gained due to the first mentioned vaccine<br />
<br />
Medical costs = Medical costs due to IPD per year in Finland in 1000 euros <br />
Medical savings = Difference in medical costs in 1000 euros per year <br />
in favor of the first mentioned vaccine<br />
<br />
Vaccine formulation considered:<br />
<br />
PCV10 includes the 10 serotypes in PCV10 and direct effects for serotypes 6A and 19A<br />
PCV10(6Af) includes the 10 serotypes in PCV10 amended <br />
by serotype 6A and direct effects (##) for 19A<br />
<br />
PCV13 includes 12 serotypes in PCV13, serotype 3 excluded. <br />
Assumes direct effects for serotypes 3 and 6C.<br />
PCV13(6Cf) includes 12 serotypes in PCV13, serotype 3 excluded <br />
and 6C added. Assumes direct effects for serotypes 3.<br />
<br />
* 1.No Vaccination<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD 330 26 124 236 302 1017<br />
QALYs lost 156 12 284 605 558 1615<br />
Medical costs (#) 918 70 1279 2431 2146 6843<br />
<br />
* 2.PCV10 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 225 15 49 30 45 362<br />
QALYs gained 105 7 102 76 86 376<br />
Medical savings(#) 608 37 504 306 320 1774<br />
<br />
* 3.PCV13 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 246 15 43 16 47 366<br />
QALYs gained 114 7 86 39 89 334<br />
Medical savings 656 38 443 160 335 1631<br />
<br />
* 4.PCV13 vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total <br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 21 0 -6 -14 2 4<br />
QALYs gained 9 0 -16 -37 3 -42<br />
Medical savings 48 1 -61 -146 15 -143<br />
<br />
* 5.PCV13(6Cf) vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65-100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 11 -1 -11 -29 -10 -40<br />
QALYs gained 4 -1 -29 -76 -21 -123<br />
Medical savings 17 -2 -116 -299 -74 -474<br />
<br />
* 6.PCV13 vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 31 2 1 6 14 54<br />
QALYs gained 15 1 1 13 28 57<br />
Medical savings 83 5 10 55 103 256<br />
<br />
* 7.PCV13(6Cf) vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 21 1 -4 -9 2 10<br />
QALYs gained 10 0 -12 -26 4 -24<br />
Medical savings 52 2 -45 -98 14 -75<br />
<br />
<br />
Interpretation <br />
-------<br />
Table 1 displays quantities when no vaccination is applied and Tables 2-3 display results for <br />
the default scenarios PCV10 and PCV13. The vaccines decrease QALYs and medical costs <br />
by approximately 20-25%. <br />
In comparison to these effets, the differences pertaining to pairwise comparisons of various <br />
versions of the vaccines (Tables 4-7) are small. Negative numbers in Tables 4-7 indicate <br />
situations favorable to PCV10.<br />
<br />
(*)= In the calculations above, the original observed/predicted number of IPD cases <br />
among under 3 year old children is multiplied 3.75. This adjustment was made to <br />
better reflect the actual disease incidence <br />
(reference: Palmu et al. (2014) Vaccine effectiveness of the pneumococcal..,<br />
The Lancet Resp. Med.Vol2,9,p.717-)<br />
<br />
(#)= costs and savings are given in 1000 euros<br />
<br />
(##)= a vaccine with "only direct effects" for a particular serotype means that, <br />
for vaccinated persons, vaccine efficacy against IPD caused by this serotype is 90% with<br />
a waning rate of 10% per year. In practise this means that approximately 70% of the <br />
serotype-specific IPD is eliminated among the <5 year olds. The implications of<br />
this modification to the results pertaining to the population as a whole<br />
are quite small and correspond closely to assuming no vaccine efficacy against <br />
the serotype in question.<br />
<br />
<br />
<br />
<br><br />
<br />
==2. Acceptable price level for PCV13 for a fixed price of PCV10 under alternative scenarios==<br />
<br><br />
<br />
This table is currently under revision (to synchronize it with tables 1-7 in Section 1 above) <br />
and will be restored by noon, 13 Sept 2014.<br />
<br />
<br><br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Cost_effectiveness_sensitivity&diff=33806Cost effectiveness sensitivity2014-09-13T11:59:16Z<p>Mnud: </p>
<hr />
<div>{{study|moderator=Jouni}}<br />
<br />
== Question ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-effectiveness analysis were assessed. Results are reported for PCV10 with modified effects for serotypes 19A and 6A and for PCV13 with modified effects for serotypes 3 and 6C.<br />
<br />
== Answer ==<br />
<br />
Conclusion: The assumption about serotype 3 in PCV13 is crucial. <br />
In addition, assumptions about the role of 6A in PCV10 is important. <br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in IPD, quality adjusted life years gained and medical costs are small (see Tables 1-7 in Section 1 below). Considering the magnitudes of these differences in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective. <br />
<br />
== Rationale ==<br />
<br><br />
<br />
==1.Vaccine effects on IPD, QALYs and costs by age group for alternative scenarios==<br />
<br><br />
<br />
Quantities tabulated:<br />
<br />
IPD = number of IPD cases per year in Finland<br />
IPD decrease = decrease in IPD due to the first mentioned vaccine<br />
<br />
QALYs lost = QALYs lost due to IPD per year in Finland, in years<br />
QALY=quality adjusted life year<br />
QALYs gained = QALYs gained due to the first mentioned vaccine<br />
<br />
Medical costs = Medical costs due to IPD per year in Finland in 1000 euros <br />
Medical savings = Difference in medical costs in 1000 euros per year in favor of the first mentioned vaccine<br />
<br />
Vaccine formulation considered:<br />
<br />
PCV10 includes the 10 serotypes in PCV10 and direct effects for serotypes 6A and 19A<br />
PCV10(6Af) includes the 10 serotypes in PCV10 amended by serotype 6A and direct effects (##) for 19A<br />
<br />
PCV13 includes 12 serotypes in PCV13, serotype 3 excluded. Assumes direct effects for serotypes 3 and 6C.<br />
PCV13(6Cf) includes 12 serotypes in PCV13, serotype 3 excluded and 6C added. Assumes direct effects for serotypes 3.<br />
<br />
* 1.No Vaccination<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD 330 26 124 236 302 1017<br />
QALYs lost 156 12 284 605 558 1615<br />
Medical costs (#) 918 70 1279 2431 2146 6843<br />
<br />
* 2.PCV10 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 225 15 49 30 45 362<br />
QALYs gained 105 7 102 76 86 376<br />
Medical savings(#) 608 37 504 306 320 1774<br />
<br />
* 3.PCV13 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 246 15 43 16 47 366<br />
QALYs gained 114 7 86 39 89 334<br />
Medical savings 656 38 443 160 335 1631<br />
<br />
* 4.PCV13 vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total <br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 21 0 -6 -14 2 4<br />
QALYs gained 9 0 -16 -37 3 -42<br />
Medical savings 48 1 -61 -146 15 -143<br />
<br />
* 5.PCV13(6Cf) vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65-100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 11 -1 -11 -29 -10 -40<br />
QALYs gained 4 -1 -29 -76 -21 -123<br />
Medical savings 17 -2 -116 -299 -74 -474<br />
<br />
* 6.PCV13 vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 31 2 1 6 14 54<br />
QALYs gained 15 1 1 13 28 57<br />
Medical savings 83 5 10 55 103 256<br />
<br />
* 7.PCV13(6Cf) vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 21 1 -4 -9 2 10<br />
QALYs gained 10 0 -12 -26 4 -24<br />
Medical savings 52 2 -45 -98 14 -75<br />
<br />
<br />
Interpretation <br />
-------<br />
Table 1 displays quantities when no vaccination is applied and Tables 2-3 display results for <br />
the default scenarios PCV10 and PCV13. The vaccines decrease QALYs and medical costs by approximately 20-25%. <br />
In comparison to these effets, the differences pertaining to pairwise comparisons of various versions of the <br />
vaccines (Tables 4-7) are small. Negative numbers in Tables 4-7 indicate situations favorable to PCV10.<br />
<br />
(*)= In the calculations above, the original observed/predicted number of IPD cases among under 3 year <br />
old children is multiplied 3.75. This adjustment was made to better reflect the actual disease incidence <br />
(reference: Palmu et al. (2014) Vaccine effectiveness of the pneumococcal..,The Lancet Resp. Med.Vol2,9,p.717-)<br />
<br />
(#)= costs and savings are given in 1000 euros<br />
<br />
(##)= a vaccine with "only direct effects" for a particular serotype means that, <br />
for vaccinated persons, vaccine efficacy against IPD caused by this serotype is 90% with<br />
a waning rate of 10% per year. In practise this means that approximately 70% of the <br />
serotype-specific IPD is eliminated among the <5 year olds. The implications of<br />
this modification to the results pertaining to the population as a whole<br />
are quite small and correspond closely to assuming no vaccine efficacy against <br />
the serotype in question.<br />
<br />
<br />
<br />
<br><br />
<br />
==2. Acceptable price level for PCV13 for a fixed price of PCV10 under alternative scenarios==<br />
<br><br />
<br />
This table is currently under revision (to synchronize it with tables 1-7 in Section 1 above) <br />
and will be restored by noon, 13 Sept 2014.<br />
<br />
<br><br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Cost_effectiveness_sensitivity&diff=33805Cost effectiveness sensitivity2014-09-13T11:53:22Z<p>Mnud: </p>
<hr />
<div>{{study|moderator=Jouni}}<br />
<br />
== Question ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-effectiveness analysis were assessed. Results are reported for PCV10 with modified effects for serotypes 19A and 6A and for PCV13 with modified effects for serotypes 3 and 6C.<br />
<br />
== Answer ==<br />
<br />
Conclusion: The assumption about serotype 3 in PCV13 is crucial. <br />
In addition, assumptions about the role of 6A in PCV10 is important. <br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in IPD, quality adjusted life years gained and medical costs are small (see Tables 1-7 in Section 1 below). Considering the magnitudes of these differences in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective. <br />
<br />
== Rationale ==<br />
<br><br />
<br />
==1.Vaccine effects on IPD, QALYs and costs by age group for alternative scenarios==<br />
<br><br />
<br />
Quantities tabulated:<br />
<br />
IPD = number of IPD cases per year in Finland<br />
IPD decrease = decrease in IPD due to the first mentioned vaccine<br />
<br />
QALYs lost = QALYs lost due to IPD per year in Finland, in years<br />
QALY=quality adjusted life year<br />
QALYs gained = QALYs gained due to the first mentioned vaccine<br />
<br />
Medical costs = Medical costs due to IPD per year in Finland in 1000 euros <br />
Medical savings = Difference in medical costs in 1000 euros per year in favor of the first mentioned vaccine<br />
<br />
Vaccine formulation considered:<br />
<br />
PCV10 includes the 10 serotypes in PCV10 and direct effects for serotypes 6A and 19A<br />
PCV10(6Af) includes the 10 serotypes in PCV10 amended by serotype 6A and direct effects (##) for 19A<br />
<br />
PCV13 includes 12 serotypes in PCV13, serotype 3 excluded. Assumes direct effects for serotypes 3 and 6C.<br />
PCV13(6Cf) includes 12 serotypes in PCV13, serotype 3 excluded and 6C added. Assumes direct effects for serotypes 3.<br />
<br />
* 1.No Vaccination<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD 330 26 124 236 302 1017<br />
QALYs lost 156 12 284 605 558 1615<br />
Medical costs (#) 918 70 1279 2431 2146 6843<br />
<br />
* 2.PCV10 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 225 15 49 30 45 362<br />
QALYs gained 105 7 102 76 86 376<br />
Medical savings(#) 608 37 504 306 320 1774<br />
<br />
* 3.PCV13 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 246 15 43 16 47 366<br />
QALYs gained 114 7 86 39 89 334<br />
Medical savings 656 38 443 160 335 1631<br />
<br />
* 4.PCV13 vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total <br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 21 0 -6 -14 2 4<br />
QALYs gained 9 0 -16 -37 3 -42<br />
Medical savings 48 1 -61 -146 15 -143<br />
<br />
* 5.PCV13(6Cf) vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65-100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 11 -1 -11 -29 -10 -40<br />
QALYs gained 4 -1 -29 -76 -21 -123<br />
Medical savings 17 -2 -116 -299 -74 -474<br />
<br />
* 6.PCV13 vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 31 2 1 6 14 54<br />
QALYs gained 15 1 1 13 28 57<br />
Medical savings 83 5 10 55 103 256<br />
<br />
* 7.PCV13(6Cf) vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 21 1 -4 -9 2 10<br />
QALYs gained 10 0 -12 -26 4 -24<br />
Medical savings 52 2 -45 -98 14 -75<br />
<br />
<br />
Interpretation <br />
-------<br />
Table 1 displays quantities when no vaccination is applied and Tables 2-3 display results for <br />
the default scenarios PCV10 and PCV13. The vaccines decrease QALYs and medical costs by approximately 20-25%. <br />
In comparison to these effets, the differences pertaining to pairwise comparisons of various versions of the <br />
vaccines (Tables 4-7) are small. Negative numbers in Tables 4-7 indicate situations favorable to PCV10.<br />
<br />
(*)= In the calculations above, the original observed/predicted number of IPD cases among under 3 year <br />
old children is multiplied 3.75. This adjustment was made to better reflect the actual disease incidence <br />
(reference: Palmu et al. (2014) Vaccine effectiveness of the pneumococcal..,The Lancet Resp. Med.Vol2,9,p.717-)<br />
<br />
(#)= costs and savings are given in 1000 euros<br />
<br />
(##)= a vaccine with "only direct effects" for a particular serotype means that, <br />
for vaccinated persons, vaccine efficacy against IPD caused by this serotype is 90% with<br />
a waning rate of 10% per year. In practise this means that approximately 70% of the <br />
serotype-specific IPD is eliminated among the <5 year olds. The implications of<br />
this modification to the results pertaining to the population as a whole<br />
are quite small and correspond closely to assuming no vaccine efficacy against <br />
the serotype in question.<br />
<br />
<br />
<br />
<br><br />
<br />
==2. Acceptable price level for PCV13 for a fixed price of PCV10 under alternative scenarios==<br />
<br><br />
Three separate tables are displayed, each corresponding to a different quantity. <br />
<br />
The three quantities of interest are:<br />
* PCV13adv.inIPD = PCV13 advantage in IPD<br />
= (IPD under PCv10) - (IPD under PCV13)<br />
if positive, PCV13 saves IPD cases compared to PCV10<br />
* price of PCV13 <br />
= if PCV10 price set at 20e, what is the matching price for PCV13?<br />
* ICER <br />
= incremental cost-effectiveness ratio for PCV10 at price 20e<br />
(in this table, this value is also average cost per QALY)<br />
<br />
rows (vaccine composition PCV10 and its 5 modifications):<br />
[1] pcv10 <br />
[2] pcv10 + 19A(direct effects only)<br />
[3] pcv10 + 6A <br />
[4] pcv10 + 19A(direct only) + 6A<br />
columns (vaccine composition PCV13 with or without serotype 3):<br />
[1] pcv13 - 3 (excluding serotype 3) <br />
[2] pcv13<br />
<br />
PCV13adv.inIPD price of PCV13 ICER<br />
============== ============== ===============<br />
PCV13-3 PCV13 PCV13-3 PCV13 PCV13-3 PCV13<br />
--- --- ------- ----- ----- ----<br />
pcv10 12 150 18 38 8077 8077<br />
pcv10+19Ad -2 134 17 37 7714 7714<br />
pcv10+6A 50 188 25 55 13590 13590<br />
pcv10+19Ad+6A 32 169 24 52 12724 12724<br />
----------------<br />
(PCV10 price=20)<br />
<br />
Interpretation <br />
-------<br />
The inclusion of serotype 3 (with full indirect effects) in PCV13 is crucial. If serotype 3 <br />
is not included in PCV13 8the default scenario), then the acceptable cost for PCV13 can be <br />
either above or below the cost of PCV10, depending on assumptions regarding the role of 6A in PCV10.<br />
<br />
<br />
<br><br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Cost_effectiveness_sensitivity&diff=33804Cost effectiveness sensitivity2014-09-13T11:48:13Z<p>Mnud: direct effects explanation added</p>
<hr />
<div>{{study|moderator=Jouni}}<br />
<br />
== Question ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-effectiveness analysis were assessed. Results are reported for PCV10 with modified effects for serotypes 19A and 6A and for PCV13 with modified effects for serotypes 3 and 6C.<br />
<br />
== Answer ==<br />
<br />
Conclusion: The assumption about serotype 3 in PCV13 is crucial. <br />
In addition, assumptions about the role of 6A in PCV10 is important. <br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in IPD, quality adjusted life years gained and medical costs are small (see Tables 1-7 in Section 1 below). Considering the magnitudes of these differences in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective. <br />
<br />
== Rationale ==<br />
<br><br />
<br />
==1.Vaccine effects on IPD, QALYs and costs by age group for alternative scenarios==<br />
<br><br />
<br />
Quantities tabulated:<br />
<br />
IPD = number of IPD cases per year in Finland<br />
IPD decrease = decrease in IPD due to the first mentioned vaccine<br />
<br />
QALYs lost = QALYs lost due to IPD per year in Finland, in years<br />
QALY=quality adjusted life year<br />
QALYs gained = QALYs gained due to the first mentioned vaccine<br />
<br />
Medical costs = Medical costs due to IPD per year in Finland in 1000 euros <br />
Medical savings = Difference in medical costs in 1000 euros per year in favor of the first mentioned vaccine<br />
<br />
Vaccine formulation considered:<br />
<br />
PCV10 includes the 10 serotypes in PCV10 and direct effects for serotypes 6A and 19A<br />
PCV10(6Af) includes the 10 serotypes in PCV10 amended by serotype 6A and direct effects (##) for 19A<br />
<br />
PCV13 includes 12 serotypes in PCV13, serotype 3 excluded. Assumes direct effects for serotypes 3 and 6C.<br />
PCV13(6Cf) includes 12 serotypes in PCV13, serotype 3 excluded and 6C added. Assumes direct effects for serotypes 3.<br />
<br />
* 1.No Vaccination<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD 330 26 124 236 302 1017<br />
QALYs lost 156 12 284 605 558 1615<br />
Medical costs (#) 918 70 1279 2431 2146 6843<br />
<br />
* 2.PCV10 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 225 15 49 30 45 362<br />
QALYs gained 105 7 102 76 86 376<br />
Medical savings(#) 608 37 504 306 320 1774<br />
<br />
* 3.PCV13 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 246 15 43 16 47 366<br />
QALYs gained 114 7 86 39 89 334<br />
Medical savings 656 38 443 160 335 1631<br />
<br />
* 4.PCV13 vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total <br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 21 0 -6 -14 2 4<br />
QALYs gained 9 0 -16 -37 3 -42<br />
Medical savings 48 1 -61 -146 15 -143<br />
<br />
* 5.PCV13(6Cf) vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65-100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 11 -1 -11 -29 -10 -40<br />
QALYs gained 4 -1 -29 -76 -21 -123<br />
Medical savings 17 -2 -116 -299 -74 -474<br />
<br />
* 6.PCV13 vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 31 2 1 6 14 54<br />
QALYs gained 15 1 1 13 28 57<br />
Medical savings 83 5 10 55 103 256<br />
<br />
* 7.PCV13(6Cf) vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 21 1 -4 -9 2 10<br />
QALYs gained 10 0 -12 -26 4 -24<br />
Medical savings 52 2 -45 -98 14 -75<br />
<br />
<br />
Interpretation <br />
-------<br />
Table 1 displays quantities when no vaccination is applied and Tables 2-3 display results for <br />
the default scenarios PCV10 and PCV13. The vaccines decrease QALYs and medical costs by approximately 20-25%. <br />
In comparison to these effets, the differences pertaining to pairwise comparisons of various versions of the <br />
vaccines (Tables 4-7) are small. Negative numbers in Tables 4-7 indicate situations favorable to PCV10.<br />
<br />
(#)= costs and savings in 1000 euros<br />
<br />
* NOTE: In the calculations above, the original observed/predicted number of IPD cases among under 3 year <br />
old children is multiplied 3.75. This adjustment was made to better reflect the actual disease incidence <br />
(reference: Palmu et al. (2014) Vaccine effectiveness of the pneumococcal..,The Lancet Resp. Med.Vol2,9,p.717-)<br />
<br />
(##) = Above, a vaccine with "only direct effects" for a particular serotype means that, <br />
for vaccinated persons, vaccine efficacy against IPD caused by this serotype is 90% with<br />
a waning rate of 10% per year. In practise this means that approximately 70% of the <br />
serotype-specific IPD is eliminated among the <5 year olds. The implications of<br />
this modification to the results pertaining to the population as a whole<br />
are quite small and correspond closely to assuming no vaccine efficacy against <br />
the serotype in question.<br />
<br />
<br />
<br />
<br><br />
<br />
==2. Acceptable price level for PCV13 for a given price of PCV10 under alternative scenarios==<br />
<br><br />
Three separate tables are displayed, each corresponding to a different quantity. <br />
<br />
The three quantities of interest are:<br />
* PCV13adv.inIPD = PCV13 advantage in IPD<br />
= (IPD under PCv10) - (IPD under PCV13)<br />
if positive, PCV13 saves IPD cases compared to PCV10<br />
* price of PCV13 <br />
= if PCV10 price set at 20e, what is the matching price for PCV13?<br />
* ICER <br />
= incremental cost-effectiveness ratio for PCV10 at price 20e<br />
(in this table, this value is also average cost per QALY)<br />
<br />
rows (vaccine composition PCV10 and its 5 modifications):<br />
[1] pcv10 <br />
[2] pcv10 + 19A(direct effects only)<br />
[3] pcv10 + 6A <br />
[4] pcv10 + 19A(direct only) + 6A<br />
columns (vaccine composition PCV13 with or without serotype 3):<br />
[1] pcv13 - 3 (excluding serotype 3) <br />
[2] pcv13<br />
<br />
PCV13adv.inIPD price of PCV13 ICER<br />
============== ============== ===============<br />
PCV13-3 PCV13 PCV13-3 PCV13 PCV13-3 PCV13<br />
--- --- ------- ----- ----- ----<br />
pcv10 12 150 18 38 8077 8077<br />
pcv10+19Ad -2 134 17 37 7714 7714<br />
pcv10+6A 50 188 25 55 13590 13590<br />
pcv10+19Ad+6A 32 169 24 52 12724 12724<br />
----------------<br />
(PCV10 price=20)<br />
<br />
Interpretation <br />
-------<br />
The inclusion of serotype 3 (with full indirect effects) in PCV13 is crucial. If serotype 3 <br />
is not included in PCV13 8the default scenario), then the acceptable cost for PCV13 can be <br />
either above or below the cost of PCV10, depending on assumptions regarding the role of 6A in PCV10.<br />
<br />
<br />
<br><br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33803Economic evaluation2014-09-13T08:51:53Z<p>Mnud: </p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. Note, that some of the ouput is irrelevant if the vaccine programme is cost saving (i.e, if savings in medical costs exceed vaccine programme cost).<br />
<br />
<br><br />
* <big>'''<u>Instructions for user: Choose the desired vaccine compositions and their prices and then press "Run code".</u>'''<br />
<br />
The results of the cost-effectiveness analysis will be displayed on a separate tab. </big><br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
costsum <- Total_costs<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
if (FALSE){#!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
#if (!is.null(debug_plot)) plot3<br />
#if (!is.null(debug_plot)) plot2<br />
#if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty...<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
ipdtable <- oapply(VacIPD, VacIPD@output["Vaccine"], sum)@output<br />
colnames(ipdtable)[colnames(ipdtable) == "VacIPDResult"] <- "N_of_IPD_cases"<br />
<br />
oprint(<br />
ipdtable[order(match(ipdtable$Vaccine, qorder)),],<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top",<br />
digits = rep(0, ncol(ipdtable) + 1)<br />
) <br />
<br />
##############################<br />
## print health care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine = qorder,<br />
Medical_costs = result(health_care_costs)[match(qorder,health_care_costs@output$Vaccine)] * 1e-6,<br />
Vaccine_programme_cost = result(vacprice) * 1e-6,<br />
Health_care_costs = result(costsum)[match(qorder,costsum@output$Vaccine)] * 1e-6<br />
)<br />
oprint(<br />
sum_table1A,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top",<br />
digits = c(0,0,2,2,2)<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(<br />
tekstia, <br />
include.rownames = FALSE, <br />
include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top"<br />
)<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained = QALYs_gained,<br />
Incremental_effect = QALYs_incremental,<br />
Health_care_costs = Cost_total * 1e-6,<br />
Incremental_cost = Cost_incremental * 1e-6,<br />
ICER = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top",<br />
digits = c(0,0,0,0,2,2,2)<br />
)<br />
</rcode><br />
<br />
<br />
== Rationale == <br />
<br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER){{reslink|Economic comparison method}}:<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Data ===<br />
Summary table of the data applied in the cost-effectiveness analysis. Note, that the cost-effectiveness analysis is based on age-year (0-100) specific data on IPD and life years lost.<br />
<br />
1. QALY_menin = QALY losses due to meningitis incl. sequlae (in years, *)<br />
2. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
3. CFR = Case fatality ratio for meningitis and bacteremia<br />
4. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
5. Cost_ menin = Medical costs attributed to meningitis incl. sequlae (in euros *)<br />
6. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
7. Menin_proportion = Proportion of meningitis cases of all IPD cases<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
{| || {{prettytable}}<br />
|+Estimated medical costs and years lost due to a single bacteremia or meningitis episode <br />
| Age class || QALY_men || QALY_bac || CFR || Life_y_lost || COST_men || COST_bac || Menin_proportion<br />
|---<br />
| <5 years || 0.22 || 0.0079 || 0.014 || 31.1 || 22 070 || 1 986 || 0.037<br />
|---<br />
| 5-64 years || 0.16 || 0.0079 || 0.112 || 20.7 || 26 488 || 9 000 || 0.046<br />
|---<br />
| 65+ years || 0.08 || 0.0079 || 0.196 || 9.4 || 21 529 || 6 823 || 0.019<br />
|---<br />
|}<br />
* Note: The above table lists averages within each age class. Cost-effectiveness analysis is based on age year -specific values.<br />
<br />
<br><br />
<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost in Finland without vaccination (per year)<br />
|---<br />
|Age group||QALY_meningitis||QALY_bacteremia||Life_years_lost||Cost_meningitis||Cost_bacteremia<br />
|---<br />
|0-4y||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|5-64y||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|65+y||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
<br />
<br><br />
<br />
=== Computation ===<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Sensitivity ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Several modifications for PCV10 and PCV13 were considered. Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in quality adjusted life years (QALYs) gained and medical costs are relatively minor. Therefore, in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective.<br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Related files ==<br />
<br />
* {{#l:GSK 04 Economic evaluation_final_for Opasnet.docx}}<br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Cost_effectiveness_sensitivity&diff=33800Cost effectiveness sensitivity2014-09-12T19:13:15Z<p>Mnud: New sensitivity analysis, old table is now section2</p>
<hr />
<div>{{study|moderator=Jouni}}<br />
<br />
== Question ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-effectiveness analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered.<br />
<br />
== Answer ==<br />
<br />
Conclusion: The assumption about serotype 3 in PCV13 is crucial. <br />
In addition, assumptions about the role of 6A in PCV10 is important. <br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in IPD (shown below), quality adjusted life years gained (not shown) and medical costs (not shown) are relatively minor. Therefore, if the vaccine price is equal for PCV10 and PCV13, then in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as roughly equally cost-effective. <br />
<br />
== Rationale ==<br />
<br><br />
<br />
==1.Vaccine effects on IPD, QALYs and costs by age group for alternative scenarios==<br />
<br><br />
<br />
Quantities tabulated:<br />
<br />
IPD = number of IPD cases per year in Finland<br />
IPD decrease = decrease in IPD due to the first mentioned vaccine<br />
<br />
QALYs lost = QALYs lost due to IPD per year in Finland, in years<br />
QALY=quality adjusted life year<br />
QALYs gained = QALYs gained due to the first mentioned vaccine<br />
<br />
Medical costs = Medical costs due to IPD per year in Finland in 1000 euros <br />
Medical savings = Difference in medical costs in 1000 euros per year in favor of the first mentioned vaccine<br />
<br />
Vaccine formulation considered:<br />
<br />
PCV10 includes the 10 serotypes in PCV10 and direct effects for serotypes 6A and 19A<br />
PCV10(6Af) includes the 10 serotypes in PCV10 amended by serotype 6A and direct effects 19A<br />
<br />
PCV13 includes 12 serotypes in PCV13, serotype 3 excluded. Assumes direct effects for serotypes 3 and 6C.<br />
PCV13(6Cf) includes 12 serotypes in PCV13, serotype 3 excluded and 6C added. Assumes direct effects for serotypes 3.<br />
<br />
* 1.No Vaccination<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD 330 26 124 236 302 1017<br />
QALYs lost 156 12 284 605 558 1615<br />
Medical costs (#) 918 70 1279 2431 2146 6843<br />
<br />
* 2.PCV10 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 225 15 49 30 45 362<br />
QALYs gained 105 7 102 76 86 376<br />
Medical savings(#) 608 37 504 306 320 1774<br />
<br />
* 3.PCV13 vs "No Vaccination"<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total<br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 246 15 43 16 47 366<br />
QALYs gained 114 7 86 39 89 334<br />
Medical savings 656 38 443 160 335 1631<br />
<br />
* 4.PCV13 vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 44- 64 65- 100 Total <br />
---- ----- ----- ----- ------ -----<br />
IPD decrease 21 0 -6 -14 2 4<br />
QALYs gained 9 0 -16 -37 3 -42<br />
Medical savings 48 1 -61 -146 15 -143<br />
<br />
* 5.PCV13(6Cf) vs PCV10<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65-100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 11 -1 -11 -29 -10 -40<br />
QALYs gained 4 -1 -29 -76 -21 -123<br />
Medical savings 17 -2 -116 -299 -74 -474<br />
<br />
* 6.PCV13 vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 31 2 1 6 14 54<br />
QALYs gained 15 1 1 13 28 57<br />
Medical savings 83 5 10 55 103 256<br />
<br />
* 7.PCV13(6Cf) vs PCV10(6Af)<br />
-------------- age group<br />
0- 4 5- 19 20- 44 45- 64 65- 100 Total<br />
---- ----- ------ ------- ------ -----<br />
IPD decrease 21 1 -4 -9 2 10<br />
QALYs gained 10 0 -12 -26 4 -24<br />
Medical savings 52 2 -45 -98 14 -75<br />
<br />
<br />
Interpretation <br />
-------<br />
Table 1 displays quantities when no vaccination is applied and Tables 2-3 display results for <br />
the default scenarios PCV10 and PCV13. The vaccines decrease QALYs and medical costs by approximately 20-25%. <br />
In comparison to these effets, the differences pertaining to pairwise comparisons of various versions of the <br />
vaccines (Tables 4-7) are small. Negative numbers in Tables 4-7 indicate situations favorable to PCV10.<br />
<br />
(#)= costs and savings in 1000 euros<br />
<br />
* NOTE: In the calculations above, the original observed/predicted number of IPD cases among under 3 year <br />
old children is multiplied 3.75. This adjustment was made to better reflect the actual disease incidence <br />
(reference: Palmu et al. (2014) Vaccine effectiveness of the pneumococcal..,The Lancet Resp. Med.Vol2,9,p.717-)<br />
<br />
<br />
<br />
<br><br />
<br />
==2. Acceptable price level for PCV13 for a given price of PCV10 under alternative scenarios==<br />
<br><br />
Three separate tables are displayed, each corresponding to a different quantity. <br />
<br />
The three quantities of interest are:<br />
* PCV13adv.inIPD = PCV13 advantage in IPD<br />
= (IPD under PCv10) - (IPD under PCV13)<br />
if positive, PCV13 saves IPD cases compared to PCV10<br />
* price of PCV13 <br />
= if PCV10 price set at 20e, what is the matching price for PCV13?<br />
* ICER <br />
= incremental cost-effectiveness ratio for PCV10 at price 20e<br />
(in this table, this value is also average cost per QALY)<br />
<br />
rows (vaccine composition PCV10 and its 5 modifications):<br />
[1] pcv10 <br />
[2] pcv10 + 19A(direct effects only)<br />
[3] pcv10 + 6A <br />
[4] pcv10 + 19A(direct only) + 6A<br />
columns (vaccine composition PCV13 with or without serotype 3):<br />
[1] pcv13 - 3 (excluding serotype 3) <br />
[2] pcv13<br />
<br />
PCV13adv.inIPD price of PCV13 ICER<br />
============== ============== ===============<br />
PCV13-3 PCV13 PCV13-3 PCV13 PCV13-3 PCV13<br />
--- --- ------- ----- ----- ----<br />
pcv10 12 150 18 38 8077 8077<br />
pcv10+19Ad -2 134 17 37 7714 7714<br />
pcv10+6A 50 188 25 55 13590 13590<br />
pcv10+19Ad+6A 32 169 24 52 12724 12724<br />
----------------<br />
(PCV10 price=20)<br />
<br />
Interpretation <br />
-------<br />
The inclusion of serotype 3 (with full indirect effects) in PCV13 is crucial. If serotype 3 <br />
is not included in PCV13 8the default scenario), then the acceptable cost for PCV13 can be <br />
either above or below the cost of PCV10, depending on assumptions regarding the role of 6A in PCV10.<br />
<br />
<br />
<br><br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Tendering_process_for_pneumococcal_conjugate_vaccine&diff=33799Tendering process for pneumococcal conjugate vaccine2014-09-12T18:05:59Z<p>Mnud: </p>
<hr />
<div>{{assessment|moderator=Jouni}}<br />
[[op_fi:Pneumokokkirokotteen_hankinta_kansalliseen_rokotusohjelmaan]]<br />
<br />
{{summary box<br />
|question = <span style="float: right; margin-right: 10px;">[[Image:Thl logo.png]]</span> How should vaccine products be compared in the national procurement of the pneumococcal conjugate vaccine in Finland?<br />
|answer = To answer this question, [[THL]] is organising an open discussion during summer and early autumn 2014. The outcome of this process is presented to the National Immunization Technical Advisory Group (NITAG) and the Ministry of Social Affairs and Health in September. The discussion is focussed on three topics:<br />
* [[Comparison criteria|What criteria should be used when comparing pneumococcal vaccine products?]]<br />
* [[Epidemiological modelling|How should the health effects of pneumococcal vaccination be assessed?]]<br />
* [[Economical assessment|How should the cost-effectiveness of pneumococcal vaccination be evaluated?]]<br />
<br />
You can participate in two ways:<br />
# Write your comments into the comment box at the end of each substance page. Moderator will include it into the text of the page.<br />
# Sign in Opasnet and participate by editing the talk pages of any substance page. See instructions for [[discussion]] and [[Help:Quick reference for wiki editing|wiki editing]].<br />
<br />
You should first browse the pneumococcus assessment pages so that you can give your comments on a right page and check whether your comment has actually been raised already. Comments are not repeated, and irrelevant comments will be removed. All relevant content will stay on the pages. Please note, however, that other participants may try to prove your comments false; if proven false, your comments as such will not be reflected in the final recommendation that is given to NITAG and the Ministry of Social Affairs and Health.<br />
<br />
<br />
}}<br />
<br />
== Question ==<br />
<br />
How should vaccine products be compared in the national procurement of the pneumococcal conjugate vaccine?<br />
<br />
=== Scope ===<br />
<br />
* We restrict the analysis to vaccination within the infant immunisation programme.<br />
* We specify criteria for comparing pneumococcal conjugate vaccine products.<br />
* The aim is to prepare selection criteria that enable the choice of the economically most advantageous tender.<br />
* We discuss assumptions underlying the epidemiological model and the cost-effectiveness analysis.<br />
* The preparation of the criteria is based on current knowledge of the impact of pneumococcal conjugate vaccination.<br />
* The procurement can only involve a product that has marketing authorisation in EU/Finland (see Section 20a of the Medicines Act [http://www.fimea.fi/download/18580_Laakelaki_englanniksi_paivitetty_5_2011.pdf](pdf)).<br />
* The procurement must follow [http://www.finlex.fi/en/laki/kaannokset/2007/en20070348?search%5Btype%5D=pika&search%5Bpika%5D=public%20procurement the Act on Public Contracts].<br />
* The discussion on these pages is not binding the preparation of the procurement.<br />
<br />
== Answer ==<br />
<br />
A preliminary answer was to base the selection criteria on the vaccine price and the predicted impact of vaccination on invasive pneumococcal disease in the entire Finnish population. Safety will not be used as one of the criteria because there is no indication about any differences in the safety of the currently licensed pneumococcal vaccine products. <br />
<br />
An epidemiological model was applied to assess the differences between the 10- and 13-valent vaccines in quality-adjusted life-years gained and in medical costs saved. If serotype 3 included in the 13-valent vaccine does not induce population level (indirect) effects, then the differences between the two vaccines in quality-adjusted life-years gained and in medical costs saved are small in comparison to differences in predictions due to intrinsic uncertainties in the model. Therefore, the vaccines can be regarded as equally effective and vaccine price should be the predominant selection criterion.<br />
<br />
== Rationale ==<br />
<br />
The rationale has been summarised in the following three pages:<br />
[[Comparison_criteria|Comparison criteria for pneumococcal vaccines]], [[Epidemiological_modelling|Epidemiological modelling]] and [[Economical_assessment|Economic evaluation]].<br />
<br />
Comparison of vaccine products will be based on their price and expected health benefits ([[Comparison_criteria|Comparison criteria for pneumococcal vaccines]]).<br />
The health benefits mean the expected reduction in the annual number of invasive pneumococcal disease in the Finnish population, if the vaccine would be used in the national infant immunisation programme. The assessment of the benefits is realised by using an [[Epidemiological_modelling|epidemiological model]]. The effectiveness of the vaccination programme will be quantified as the<br />
expected improvement in health-associated quality of life. The selection criterion is formulated so that the most cost-effective<br />
will be identified ([[Economical_assessment|Economic evaluation]]).<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Tendering_process_for_pneumococcal_conjugate_vaccine&diff=33798Tendering process for pneumococcal conjugate vaccine2014-09-12T16:49:41Z<p>Mnud: </p>
<hr />
<div>{{assessment|moderator=Jouni}}<br />
[[op_fi:Pneumokokkirokotteen_hankinta_kansalliseen_rokotusohjelmaan]]<br />
<br />
{{summary box<br />
|question = <span style="float: right; margin-right: 10px;">[[Image:Thl logo.png]]</span> How should vaccine products be compared in the national procurement of the pneumococcal conjugate vaccine in Finland?<br />
|answer = To answer this question, [[THL]] is organising an open discussion during summer and early autumn 2014. The outcome of this process is presented to the National Immunization Technical Advisory Group (NITAG) and the Ministry of Social Affairs and Health in September. The discussion is focussed on three topics:<br />
* [[Comparison criteria|What criteria should be used when comparing pneumococcal vaccine products?]]<br />
* [[Epidemiological modelling|How should the health effects of pneumococcal vaccination be assessed?]]<br />
* [[Economical assessment|How should the cost-effectiveness of pneumococcal vaccination be evaluated?]]<br />
<br />
You can participate in two ways:<br />
# Write your comments into the comment box at the end of each substance page. Moderator will include it into the text of the page.<br />
# Sign in Opasnet and participate by editing the talk pages of any substance page. See instructions for [[discussion]] and [[Help:Quick reference for wiki editing|wiki editing]].<br />
<br />
You should first browse the pneumococcus assessment pages so that you can give your comments on a right page and check whether your comment has actually been raised already. Comments are not repeated, and irrelevant comments will be removed. All relevant content will stay on the pages. Please note, however, that other participants may try to prove your comments false; if proven false, your comments as such will not be reflected in the final recommendation that is given to NITAG and the Ministry of Social Affairs and Health.<br />
<br />
<br />
}}<br />
<br />
== Question ==<br />
<br />
How should vaccine products be compared in the national procurement of the pneumococcal conjugate vaccine?<br />
<br />
=== Scope ===<br />
<br />
* We restrict the analysis to vaccination within the infant immunisation programme.<br />
* We specify criteria for comparing pneumococcal conjugate vaccine products.<br />
* The aim is to prepare selection criteria that enable the choice of the economically most advantageous tender.<br />
* We discuss assumptions underlying the epidemiological model and the cost-effectiveness analysis.<br />
* The preparation of the criteria is based on current knowledge of the impact of pneumococcal conjugate vaccination.<br />
* The procurement can only involve a product that has marketing authorisation in EU/Finland (see Section 20a of the Medicines Act [http://www.fimea.fi/download/18580_Laakelaki_englanniksi_paivitetty_5_2011.pdf](pdf)).<br />
* The procurement must follow [http://www.finlex.fi/en/laki/kaannokset/2007/en20070348?search%5Btype%5D=pika&search%5Bpika%5D=public%20procurement the Act on Public Contracts].<br />
* The discussion on these pages is not binding the preparation of the procurement.<br />
<br />
== Answer ==<br />
<br />
A preliminary answer was to base the selection criteria on the vaccine price and the predicted impact of vaccination on invasive pneumococcal disease in the entire Finnish population. Safety will not be used as one of the criteria because there is no indication about any differences in the safety of the currently licensed pneumococcal vaccine products. <br />
<br />
An epidemiological model was applied to assess the differences between the 10- and 13-valent vaccines in quality-adjusted life-years gained and in medical costs saved. If serotype 3 is not included as a vaccine type in the 13-valent vaccine, then the differences between the two vaccines in quality-adjusted life-years gained and in medical costs saved are small in comparison to differences in predictions due to intrinsic uncertainties in the model. Therefore, the vaccines can be regarded as equally effective and vaccine price should be the predominant selection criterion.<br />
<br />
== Rationale ==<br />
<br />
The rationale has been summarised in the following three pages:<br />
[[Comparison_criteria|Comparison criteria for pneumococcal vaccines]], [[Epidemiological_modelling|Epidemiological modelling]] and [[Economical_assessment|Economic evaluation]].<br />
<br />
Comparison of vaccine products will be based on their price and expected health benefits ([[Comparison_criteria|Comparison criteria for pneumococcal vaccines]]).<br />
The health benefits mean the expected reduction in the annual number of invasive pneumococcal disease in the Finnish population, if the vaccine would be used in the national infant immunisation programme. The assessment of the benefits is realised by using an [[Epidemiological_modelling|epidemiological model]]. The effectiveness of the vaccination programme will be quantified as the<br />
expected improvement in health-associated quality of life. The selection criterion is formulated so that the most cost-effective<br />
will be identified ([[Economical_assessment|Economic evaluation]]).<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Tendering_process_for_pneumococcal_conjugate_vaccine&diff=33797Tendering process for pneumococcal conjugate vaccine2014-09-12T16:46:45Z<p>Mnud: </p>
<hr />
<div>{{assessment|moderator=Jouni}}<br />
[[op_fi:Pneumokokkirokotteen_hankinta_kansalliseen_rokotusohjelmaan]]<br />
<br />
{{summary box<br />
|question = <span style="float: right; margin-right: 10px;">[[Image:Thl logo.png]]</span> How should vaccine products be compared in the national procurement of the pneumococcal conjugate vaccine in Finland?<br />
|answer = To answer this question, [[THL]] is organising an open discussion during summer and early autumn 2014. The outcome of this process is presented to the National Immunization Technical Advisory Group (NITAG) and the Ministry of Social Affairs and Health in September. The discussion is focussed on three topics:<br />
* [[Comparison criteria|What criteria should be used when comparing pneumococcal vaccine products?]]<br />
* [[Epidemiological modelling|How should the health effects of pneumococcal vaccination be assessed?]]<br />
* [[Economical assessment|How should the cost-effectiveness of pneumococcal vaccination be evaluated?]]<br />
<br />
You can participate in two ways:<br />
# Write your comments into the comment box at the end of each substance page. Moderator will include it into the text of the page.<br />
# Sign in Opasnet and participate by editing the talk pages of any substance page. See instructions for [[discussion]] and [[Help:Quick reference for wiki editing|wiki editing]].<br />
<br />
You should first browse the pneumococcus assessment pages so that you can give your comments on a right page and check whether your comment has actually been raised already. Comments are not repeated, and irrelevant comments will be removed. All relevant content will stay on the pages. Please note, however, that other participants may try to prove your comments false; if proven false, your comments as such will not be reflected in the final recommendation that is given to NITAG and the Ministry of Social Affairs and Health.<br />
<br />
<br />
}}<br />
<br />
== Question ==<br />
<br />
How should vaccine products be compared in the national procurement of the pneumococcal conjugate vaccine?<br />
<br />
=== Scope ===<br />
<br />
* We restrict the analysis to vaccination within the infant immunisation programme.<br />
* We specify criteria for comparing pneumococcal conjugate vaccine products.<br />
* The aim is to prepare selection criteria that enable the choice of the economically most advantageous tender.<br />
* We discuss assumptions underlying the epidemiological model and the cost-effectiveness analysis.<br />
* The preparation of the criteria is based on current knowledge of the impact of pneumococcal conjugate vaccination.<br />
* The procurement can only involve a product that has marketing authorisation in EU/Finland (see Section 20a of the Medicines Act [http://www.fimea.fi/download/18580_Laakelaki_englanniksi_paivitetty_5_2011.pdf](pdf)).<br />
* The procurement must follow [http://www.finlex.fi/en/laki/kaannokset/2007/en20070348?search%5Btype%5D=pika&search%5Bpika%5D=public%20procurement the Act on Public Contracts].<br />
* The discussion on these pages is not binding the preparation of the procurement.<br />
<br />
== Answer ==<br />
<br />
A preliminary answer was to base the selection criteria on the vaccine price and the predicted impact of vaccination on invasive pneumococcal disease in the entire Finnish population. Safety will not be used as one of the criteria because there is no indication about any differences in the safety of the currently licensed pneumococcal vaccine products. <br />
<br />
An epidemiological model was applied to assess the differences between the 10- and 13-valent vaccines in quality-adjusted life-years gained and in medical costs saved. If serotype 3 is not included as a vaccine type in the 13-valent vaccine, then the differences between the two vaccines in quality-adjusted life-years gained and in medical costs saved are small in comparison with differences in predictions due to intrinsic uncertainties in the model. Therefore, the vaccines can be regarded as equally effective and vaccine price should be the predominant selection criterion.<br />
<br />
== Rationale ==<br />
<br />
The rationale has been summarised in the following three pages:<br />
[[Comparison_criteria|Comparison criteria for pneumococcal vaccines]], [[Epidemiological_modelling|Epidemiological modelling]] and [[Economical_assessment|Economic evaluation]].<br />
<br />
Comparison of vaccine products will be based on their price and expected health benefits ([[Comparison_criteria|Comparison criteria for pneumococcal vaccines]]).<br />
The health benefits mean the expected reduction in the annual number of invasive pneumococcal disease in the Finnish population, if the vaccine would be used in the national infant immunisation programme. The assessment of the benefits is realised by using an [[Epidemiological_modelling|epidemiological model]]. The effectiveness of the vaccination programme will be quantified as the<br />
expected improvement in health-associated quality of life. The selection criterion is formulated so that the most cost-effective<br />
will be identified ([[Economical_assessment|Economic evaluation]]).<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33796Economic evaluation2014-09-12T16:35:38Z<p>Mnud: Caveat if vaccine is cost saving</p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. Note, that much of the ouput is not valid if the vaccine programme is cost saving (i.e, if savings in medical costs exceed Vaccine programme cost).<br />
<br />
<br><br />
* <big>'''<u>Instructions for user: Choose the desired vaccine compositions and their prices and then press "Run code".</u>'''<br />
<br />
The results of the cost-effectiveness analysis will be displayed on a separate tab. </big><br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
costsum <- Total_costs<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
if (FALSE){#!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
#if (!is.null(debug_plot)) plot3<br />
#if (!is.null(debug_plot)) plot2<br />
#if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty...<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
ipdtable <- oapply(VacIPD, VacIPD@output["Vaccine"], sum)@output<br />
colnames(ipdtable)[colnames(ipdtable) == "VacIPDResult"] <- "N_of_IPD_cases"<br />
<br />
oprint(<br />
ipdtable[order(match(ipdtable$Vaccine, qorder)),],<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top",<br />
digits = rep(0, ncol(ipdtable) + 1)<br />
) <br />
<br />
##############################<br />
## print health care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine = qorder,<br />
Medical_costs = result(health_care_costs)[match(qorder,health_care_costs@output$Vaccine)] * 1e-6,<br />
Vaccine_programme_cost = result(vacprice) * 1e-6,<br />
Health_care_costs = result(costsum)[match(qorder,costsum@output$Vaccine)] * 1e-6<br />
)<br />
oprint(<br />
sum_table1A,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top",<br />
digits = c(0,0,2,2,2)<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(<br />
tekstia, <br />
include.rownames = FALSE, <br />
include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top"<br />
)<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained = QALYs_gained,<br />
Incremental_effect = QALYs_incremental,<br />
Health_care_costs = Cost_total * 1e-6,<br />
Incremental_cost = Cost_incremental * 1e-6,<br />
ICER = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top",<br />
digits = c(0,0,0,0,2,2,2)<br />
)<br />
</rcode><br />
<br />
<br />
== Rationale == <br />
<br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER){{reslink|Economic comparison method}}:<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Data ===<br />
Summary table of the data applied in the cost-effectiveness analysis. Note, that the cost-effectiveness analysis is based on age-year (0-100) specific data on IPD and life years lost.<br />
<br />
1. QALY_menin = QALY losses due to meningitis incl. sequlae (in years, *)<br />
2. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
3. CFR = Case fatality ratio for meningitis and bacteremia<br />
4. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
5. Cost_ menin = Medical costs attributed to meningitis incl. sequlae (in euros *)<br />
6. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
7. Menin_proportion = Proportion of meningitis cases of all IPD cases<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
{| || {{prettytable}}<br />
|+Estimated medical costs and years lost due to a single bacteremia or meningitis episode <br />
| Age class || QALY_men || QALY_bac || CFR || Life_y_lost || COST_men || COST_bac || Menin_proportion<br />
|---<br />
| <5 years || 0.22 || 0.0079 || 0.014 || 31.1 || 22 070 || 1 986 || 0.037<br />
|---<br />
| 5-64 years || 0.16 || 0.0079 || 0.112 || 20.7 || 26 488 || 9 000 || 0.046<br />
|---<br />
| 65+ years || 0.08 || 0.0079 || 0.196 || 9.4 || 21 529 || 6 823 || 0.019<br />
|---<br />
|}<br />
* Note: The above table lists averages within each age class. Cost-effectiveness analysis is based on age year -specific values.<br />
<br />
<br><br />
<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost in Finland without vaccination (per year)<br />
|---<br />
|Age group||QALY_meningitis||QALY_bacteremia||Life_years_lost||Cost_meningitis||Cost_bacteremia<br />
|---<br />
|0-4y||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|5-64y||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|65+y||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
<br />
<br><br />
<br />
=== Computation ===<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Sensitivity ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Several modifications for PCV10 and PCV13 were considered. Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in quality adjusted life years (QALYs) gained and medical costs are relatively minor. Therefore, in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective.<br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Related files ==<br />
<br />
* {{#l:GSK 04 Economic evaluation_final_for Opasnet.docx}}<br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Tendering_process_for_pneumococcal_conjugate_vaccine&diff=33795Tendering process for pneumococcal conjugate vaccine2014-09-12T15:56:33Z<p>Mnud: Answer: vaccine price should be the predominant selection criterion</p>
<hr />
<div>{{assessment|moderator=Jouni}}<br />
[[op_fi:Pneumokokkirokotteen_hankinta_kansalliseen_rokotusohjelmaan]]<br />
<br />
{{summary box<br />
|question = <span style="float: right; margin-right: 10px;">[[Image:Thl logo.png]]</span> How should vaccine products be compared in the national procurement of the pneumococcal conjugate vaccine in Finland?<br />
|answer = To answer this question, [[THL]] is organising an open discussion during summer and early autumn 2014. The outcome of this process is presented to the National Immunization Technical Advisory Group (NITAG) and the Ministry of Social Affairs and Health in September. The discussion is focussed on three topics:<br />
* [[Comparison criteria|What criteria should be used when comparing pneumococcal vaccine products?]]<br />
* [[Epidemiological modelling|How should the health effects of pneumococcal vaccination be assessed?]]<br />
* [[Economical assessment|How should the cost-effectiveness of pneumococcal vaccination be evaluated?]]<br />
<br />
You can participate in two ways:<br />
# Write your comments into the comment box at the end of each substance page. Moderator will include it into the text of the page.<br />
# Sign in Opasnet and participate by editing the talk pages of any substance page. See instructions for [[discussion]] and [[Help:Quick reference for wiki editing|wiki editing]].<br />
<br />
You should first browse the pneumococcus assessment pages so that you can give your comments on a right page and check whether your comment has actually been raised already. Comments are not repeated, and irrelevant comments will be removed. All relevant content will stay on the pages. Please note, however, that other participants may try to prove your comments false; if proven false, your comments as such will not be reflected in the final recommendation that is given to NITAG and the Ministry of Social Affairs and Health.<br />
<br />
<br />
}}<br />
<br />
== Question ==<br />
<br />
How should vaccine products be compared in the national procurement of the pneumococcal conjugate vaccine?<br />
<br />
=== Scope ===<br />
<br />
* We restrict the analysis to vaccination within the infant immunisation programme.<br />
* We specify criteria for comparing pneumococcal conjugate vaccine products.<br />
* The aim is to prepare selection criteria that enable the choice of the economically most advantageous tender.<br />
* We discuss assumptions underlying the epidemiological model and the cost-effectiveness analysis.<br />
* The preparation of the criteria is based on current knowledge of the impact of pneumococcal conjugate vaccination.<br />
* The procurement can only involve a product that has marketing authorisation in EU/Finland (see Section 20a of the Medicines Act [http://www.fimea.fi/download/18580_Laakelaki_englanniksi_paivitetty_5_2011.pdf](pdf)).<br />
* The procurement must follow [http://www.finlex.fi/en/laki/kaannokset/2007/en20070348?search%5Btype%5D=pika&search%5Bpika%5D=public%20procurement the Act on Public Contracts].<br />
* The discussion on these pages is not binding the preparation of the procurement.<br />
<br />
== Answer ==<br />
<br />
A preliminary answer was to base the selection criteria on the vaccine price and the predicted impact of vaccination on invasive pneumococcal disease in the entire Finnish population. Safety will not be used as one of the criteria because there is no indication about any differences in the safety of the currently licensed pneumococcal vaccine products. <br />
<br />
An epidemioligical model was applied to assess the differences between the 10- and 13-valent vaccines in quality-adjusted life-years gained and in medical costs saved. If serotype 3 is not included as a vaccine type in the 13-valent vaccine, then the differences between the two vaccines in quality-adjusted life-years gained and in medical costs saved are small in comparison with differences in predictions due to intrinsic uncertainties in the model. Therefore, the vaccines can be regarded as equally effective and vaccine price should be the predominant selection criterion.<br />
<br />
== Rationale ==<br />
<br />
The rationale has been summarised in the following three pages:<br />
[[Comparison_criteria|Comparison criteria for pneumococcal vaccines]], [[Epidemiological_modelling|Epidemiological modelling]] and [[Economical_assessment|Economic evaluation]].<br />
<br />
Comparison of vaccine products will be based on their price and expected health benefits ([[Comparison_criteria|Comparison criteria for pneumococcal vaccines]]).<br />
The health benefits mean the expected reduction in the annual number of invasive pneumococcal disease in the Finnish population, if the vaccine would be used in the national infant immunisation programme. The assessment of the benefits is realised by using an [[Epidemiological_modelling|epidemiological model]]. The effectiveness of the vaccination programme will be quantified as the<br />
expected improvement in health-associated quality of life. The selection criterion is formulated so that the most cost-effective<br />
will be identified ([[Economical_assessment|Economic evaluation]]).<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33794Economic evaluation2014-09-12T13:45:04Z<p>Mnud: </p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. <br />
<br />
<br><br />
* <big>'''<u>Instructions for user: Choose the desired vaccine compositions and their prices and then press "Run code".</u>'''<br />
<br />
The results of the cost-effectiveness analysis will be displayed on a separate tab. </big><br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
costsum <- Total_costs<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
if (FALSE){#!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
#if (!is.null(debug_plot)) plot3<br />
#if (!is.null(debug_plot)) plot2<br />
#if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty...<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
ipdtable <- oapply(VacIPD, VacIPD@output["Vaccine"], sum)@output<br />
colnames(ipdtable)[colnames(ipdtable) == "VacIPDResult"] <- "N_of_IPD_cases"<br />
<br />
oprint(<br />
ipdtable[order(match(ipdtable$Vaccine, qorder)),],<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top",<br />
digits = rep(0, ncol(ipdtable) + 1)<br />
) <br />
<br />
##############################<br />
## print health care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine = qorder,<br />
Medical_costs = result(health_care_costs)[match(qorder,health_care_costs@output$Vaccine)] * 1e-6,<br />
Vaccine_programme_cost = result(vacprice) * 1e-6,<br />
Health_care_costs = result(costsum)[match(qorder,costsum@output$Vaccine)] * 1e-6<br />
)<br />
oprint(<br />
sum_table1A,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top",<br />
digits = c(0,0,2,2,2)<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(<br />
tekstia, <br />
include.rownames = FALSE, <br />
include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top"<br />
)<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained = QALYs_gained,<br />
Incremental_effect = QALYs_incremental,<br />
Health_care_costs = Cost_total * 1e-6,<br />
Incremental_cost = Cost_incremental * 1e-6,<br />
ICER = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top",<br />
digits = c(0,0,0,0,2,2,2)<br />
)<br />
</rcode><br />
<br />
<br />
== Rationale == <br />
<br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER){{reslink|Economic comparison method}}:<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Data ===<br />
Summary table of the data applied in the cost-effectiveness analysis. Note, that the cost-effectiveness analysis is based on age-year (0-100) specific data on IPD and life years lost.<br />
<br />
1. QALY_menin = QALY losses due to meningitis incl. sequlae (in years, *)<br />
2. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
3. CFR = Case fatality ratio for meningitis and bacteremia<br />
4. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
5. Cost_ menin = Medical costs attributed to meningitis incl. sequlae (in euros *)<br />
6. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
7. Menin_proportion = Proportion of meningitis cases of all IPD cases<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
{| || {{prettytable}}<br />
|+Estimated medical costs and years lost due to a single bacteremia or meningitis episode <br />
| Age class || QALY_men || QALY_bac || CFR || Life_y_lost || COST_men || COST_bac || Menin_proportion<br />
|---<br />
| <5 years || 0.22 || 0.0079 || 0.014 || 31.1 || 22 070 || 1 986 || 0.037<br />
|---<br />
| 5-64 years || 0.16 || 0.0079 || 0.112 || 20.7 || 26 488 || 9 000 || 0.046<br />
|---<br />
| 65+ years || 0.08 || 0.0079 || 0.196 || 9.4 || 21 529 || 6 823 || 0.019<br />
|---<br />
|}<br />
* Note: The above table lists averages within each age class. Cost-effectiveness analysis is based on age year -specific values.<br />
<br />
<br><br />
<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost in Finland without vaccination (per year)<br />
|---<br />
|Age group||QALY_meningitis||QALY_bacteremia||Life_years_lost||Cost_meningitis||Cost_bacteremia<br />
|---<br />
|0-4y||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|5-64y||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|65+y||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
<br />
<br><br />
<br />
=== Computation ===<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Sensitivity ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Several modifications for PCV10 and PCV13 were considered. Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in quality adjusted life years (QALYs) gained and medical costs are relatively minor. Therefore, in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective.<br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Related files ==<br />
<br />
* {{#l:GSK 04 Economic evaluation_final_for Opasnet.docx}}<br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33793Economic evaluation2014-09-12T13:43:00Z<p>Mnud: sensitivity statement</p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. <br />
<br />
<br><br />
* <big>'''<u>Instructions for user: Choose the desired vaccine compositions and their prices and then press "Run code".</u>'''<br />
<br />
The results of the cost-effectiveness analysis will be displayed on a separate tab. </big><br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
costsum <- Total_costs<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
if (FALSE){#!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
#if (!is.null(debug_plot)) plot3<br />
#if (!is.null(debug_plot)) plot2<br />
#if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty...<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
ipdtable <- oapply(VacIPD, VacIPD@output["Vaccine"], sum)@output<br />
colnames(ipdtable)[colnames(ipdtable) == "VacIPDResult"] <- "N_of_IPD_cases"<br />
<br />
oprint(<br />
ipdtable[order(match(ipdtable$Vaccine, qorder)),],<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top",<br />
digits = rep(0, ncol(ipdtable) + 1)<br />
) <br />
<br />
##############################<br />
## print health care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine = qorder,<br />
Medical_costs = result(health_care_costs)[match(qorder,health_care_costs@output$Vaccine)] * 1e-6,<br />
Vaccine_programme_cost = result(vacprice) * 1e-6,<br />
Health_care_costs = result(costsum)[match(qorder,costsum@output$Vaccine)] * 1e-6<br />
)<br />
oprint(<br />
sum_table1A,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top",<br />
digits = c(0,0,2,2,2)<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(<br />
tekstia, <br />
include.rownames = FALSE, <br />
include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top"<br />
)<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained = QALYs_gained,<br />
Incremental_effect = QALYs_incremental,<br />
Health_care_costs = Cost_total * 1e-6,<br />
Incremental_cost = Cost_incremental * 1e-6,<br />
ICER = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top",<br />
digits = c(0,0,0,0,2,2,2)<br />
)<br />
</rcode><br />
<br />
<br />
== Rationale == <br />
<br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER){{reslink|Economic comparison method}}:<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Data ===<br />
Summary table of the data applied in the cost-effectiveness analysis. Note, that the cost-effectiveness analysis is based on age-year (0-100) specific data on IPD and life years lost.<br />
<br />
1. QALY_menin = QALY losses due to meningitis incl. sequlae (in years, *)<br />
2. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
3. CFR = Case fatality ratio for meningitis and bacteremia<br />
4. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
5. Cost_ menin = Medical costs attributed to meningitis incl. sequlae (in euros *)<br />
6. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
7. Menin_proportion = Proportion of meningitis cases of all IPD cases<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
{| || {{prettytable}}<br />
|+Estimated medical costs and years lost due to a single bacteremia or meningitis episode <br />
| Age class || QALY_men || QALY_bac || CFR || Life_y_lost || COST_men || COST_bac || Menin_proportion<br />
|---<br />
| <5 years || 0.22 || 0.0079 || 0.014 || 31.1 || 22 070 || 1 986 || 0.037<br />
|---<br />
| 5-64 years || 0.16 || 0.0079 || 0.112 || 20.7 || 26 488 || 9 000 || 0.046<br />
|---<br />
| 65+ years || 0.08 || 0.0079 || 0.196 || 9.4 || 21 529 || 6 823 || 0.019<br />
|---<br />
|}<br />
* Note: The above table lists averages within each age class. Cost-effectiveness analysis is based on age year -specific values.<br />
<br />
<br><br />
<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost in Finland without vaccination (per year)<br />
|---<br />
|Age group||QALY_meningitis||QALY_bacteremia||Life_years_lost||Cost_meningitis||Cost_bacteremia<br />
|---<br />
|0-4y||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|5-64y||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|65+y||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
<br />
<br><br />
<br />
=== Computation ===<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Sensitivity ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in quality adjusted life years (QALYs) gained and medical costs are relatively minor. Therefore, in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as equally effective.<br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Related files ==<br />
<br />
* {{#l:GSK 04 Economic evaluation_final_for Opasnet.docx}}<br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Cost_effectiveness_sensitivity&diff=33786Cost effectiveness sensitivity2014-09-11T08:00:35Z<p>Mnud: uncertainty conclusion added</p>
<hr />
<div>{{study|moderator=Jouni}}<br />
<br />
== Question ==<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-effectiveness analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered.<br />
<br />
== Answer ==<br />
<br />
Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. <br />
<br />
If serotype 3 is not included as a vaccine type in PCV13, then the differences between PCV10 and PCV13 in IPD (shown below), quality adjusted life years gained (not shown) and medical costs (not shown) are relatively minor. Therefore, if the vaccine price is equal for PCV10 and PCV13, then in view of the intrinsic uncertainties in the model, PCV10 and PCV13 can be regarded as roughly equally cost-effective. <br />
<br />
== Rationale ==<br />
<br />
Three separate tables are displayed, each corresponding to a different quantity. <br />
The three quantities of interest are:<br />
*PCV13adv.inIPD <br />
= (IPD under PCv10) - (IPD under PCV13)<br />
if positive, PCV13 saves IPD cases compared to PCV10<br />
*price of PCV13 <br />
= if PCV10 price set at 20e, what is the matching price for PCV13?<br />
*ICER <br />
= incremental cost-effectiveness ratio for PCV10 at price 20e<br />
(in this table, this value is also average cost per QALY)<br />
<br />
rows (vaccine composition PCV10 and its 5 modifications):<br />
[1] pcv10 <br />
[2] pcv10 + 19A(direct effects only)<br />
[3] pcv10 + 6A <br />
[4] pcv10 + 19A(direct only) + 6A<br />
[5] pcv10 + 19A(full) <br />
[6] pcv10 + 19A(full) + 6A = PCV13 - 3<br />
columns (vaccine composition PCV13 with or without serotype 3):<br />
[1] pcv13 - 3 (excluding serotype 3) <br />
[2] pcv13<br />
<br />
PCV13adv.inIPD price of PCV13 ICER<br />
============== ============== ===============<br />
PCV13-3 PCV13 PCV13-3 PCV13 PCV13-3 PCV13<br />
--- --- ------- ----- ----- ----<br />
pcv10 12 150 18 38 8077 8077<br />
pcv10+19Ad -2 134 17 37 7714 7714<br />
pcv10+6A 50 188 25 55 13590 13590<br />
pcv10+19Ad+6A 32 169 24 52 12724 12724<br />
pcv10+19Af -31 105 15 32 6198 6199<br />
pcv10+19Af+6A * 137 * 43 * 9672<br />
----------------<br />
(PCV10 price=20)<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Talk:Comparison_criteria&diff=33536Talk:Comparison criteria2014-09-02T12:56:07Z<p>Mnud: comments copied from the Finnish page</p>
<hr />
<div>== Discussion on comparison criteria ==<br />
<br />
'''Comment K3<br />
<br />
1. PCV tender criteria from other Nordic countries show that quality is valued and given greater weight than price also where the winning vaccine is considered the “economic most advantageous”. Quality points should be given to several dimensions, not just for number of serotypes in the vaccine; <br />
<br />
* see examples: <br />
<br />
<u>Norway</u> (2011) <br><br />
Quality 50-70%, price 20-40%, service after delivery 5% “The offer that achieves the highest point score after adding up the calculated points for each of the weighted criteria for assignment will be considered as the financially most favorable offer.” <br />
<br />
Criteria: Requirement: It must be possible to store the vaccine at 25°C for at least 48 hours, without altering the vaccine properties. Documentation: stability studies The expected number of preventable cases of systemic pneumococcal disease. The efficacy of the vaccine against systemic pneumococcal disease caused by the different serotypes in the vaccine will be of significance. Other relevant conditions, including clinical documentation on the efficacy against otitis caused by S.pneumoniae. The best possible safety profile in this particular population. The offered vaccine may be part of a vaccination program where both available pneumococcal vaccines can be used. The prevalence in Norway of the individual disease-developing serotypes will be considered. The efficacy and risk/benefit assessment of the vaccines will be assessed on a rough estimate based on the presented documentation. Documentation assessed by competent authorities in the EEA-union will be of particular importance. Price pr. dose size is given as one price, which is applicable independently of the delivered dose, i.e. if it is delivered as one dose pack or as 10-dose packs. Service after delivery (5%) Service availability and technical assistance will be emphasized <br />
<br />
<u>Denmark</u> (2014)<br><br />
Quality 75%, price 25% “The framework contract will be awarded on the basis of the award criterion the economic most advantageous tender . <br />
Criteria: The effectiveness is assessed on the basis of the vaccine's coverage of invasive pneumococcal diseases in children < 2 years (35%) and the product's direct and indirect coverage of invasive pneumococcal diseases in the rest of the population (25%) in Denmark in 2009 based on the applicable SPC (Summary of Product Characteristics). The tenderer must complete a form concerning the indication of effectiveness of pneumococcal serotypes contained in the vaccine on the basis of the applicable SPC. Type and frequency of adverse effects (10%): assessed on the basis of the applicable SPC. As few and least invasive adverse effects as possible are desired. The active ingredients/trace elements of the products (5%): it is assessed whether the product is manufactured by or includes materials or trace elements of animal or human origin or other ingredients that may potentially pose a risk to the child/patient. The assessment is made on the basis of an applicable SPC, a completed form relating to active ingredients/trace elements enclosed with the tender documents as well as any statement as to no active ingredients and other relevant material, as described in section 10.4. As few active ingredients and trace elements that may potentially pose a risk to the child/the patients as possible are desired. The price will be assessed on the basis of the average price for the period 2014-2017. The lowest price possible is desired. <br />
<br />
<u>Sweden, Stockholm</u> (2015) <br><br />
Quality emphasized. If the tender gets 100 points for quality, the price will be multiplied by 1. If, for example, the tender gets 50 quality points, the price will be multiplied by 1,50. <br />
Criteria: Clinical efficacy, safety (max 90 points): Range of serotype protection, documentation on efficacy and effectiveness, documentation on risk groups, documentation on antibody response, side effect profile, excipients and preservatives. Very good safety profile, good clinical efficacy, optimal protection in terms of serotype coverage, documentation on risk groups: 90 points: Very good safety profile, good clinical efficacy but not optimal protection in terms of serotype coverage, no documentation on risk groups: 20 points Line width, practical management, labelling (max 10 points) Size, needles, design (risk of mix up), clear labelling and presence of bar code, storage conditions, handling in general <br />
<br />
<u>Sweden, VGR</u> (Region Västra Götaland) <br><br />
Quality 70%, price 30% <br />
Criteria: Clinical efficacy (max 60 p): Number of serotypes, clinical efficacy on individual level, proven herd immunity, approved indications. Based on RCT and/or other studies, official authority statements Very Good:48-60 points Good: 34-47 points Acceptable: 20-33 points Less good: 10-19 points Poor or not gradable: 0-9 points: Clinical safety (max 60 p): Side effect profile in SmPC/WHO, RCT and/or other studies, official authority statements. Aluminum content. Very good: 48-60 points Good: 34-47 points Acceptable: 20-33 points Less good: 10-19 points Poor or not gradable: 0-9 points Product range (max 10 p) Will be evaluated if relevant, otherwise maximum points will be awarded. Package size: 0-5 points Dosing schedule: 0-5 points Practical management (max 30 p) Will be evaluated if relevant, otherwise maximum points will be awarded Storage conditions (e.g. light sensitive, storage in cold, durability):0-10 points Formulation aspects (e.g. dry matter/vial/pre-filled syringe, preparation instructions): 0-5 points Product itself (e.g. manageability at the preparation and administration, packaging design): 0-15 points Marking and labelling (max 20 p) The bidder shall submit Mock-ups on the outer packaging and images on the inner packaging to the bid, and blister on all offered products. If need of pharmaceutical samples, the company will be contacted. Barcode (outer and inner packaging): 0-10 points Labelling (outer and inner packaging, readability on the syringe label, removable label): 0-10 points<br />
<br />
<br><br />
<br />
'''Comment K4<br />
<br />
It is appreciable Opasnet is a source of transparency. As JCVI and ACIP do, is it planned to inform the general public by publishing regularly the evaluation and decision processes, including analysis and results, at Opasnet or somewhere else?<br />
<br />
<br />
'''Comment K5<br />
<br />
Vaccine efficacy on non-typeable Haemophilus influenzae cannot be taken into account as comparison criterion because neither of the vaccines have prevention of NTHi in their indication. Moreover, for both vaccines the Summary of Product Characteristics (SmPC) approved by European Medicines Agency states in section 4.4., Special warnings and precautions, that the vaccines do not provide protection against other bacteria: Synflorix: There is insufficient evidence that Synflorix provides protection against pneumococcal serotypes not contained in the vaccine or against non-typeable Haemophilus influenzae. Synflorix does not provide protection against other micro-organism Prevenar 13: Prevenar13 will only protect against Streptococcus pneumonia serotypes included in the vaccine, and will not protect against other microorganism that cause invasive disease, pneumonia or otitis media. Based on the same sentences in SmPCs of the vaccines, the vaccines do not provide protection against other serotypes than those contained in the vaccines. Therefore, adjustability of the serotype composition in the economic assessment (http://en.opasnet.org/w/Economical_assessment ) is purposeless and the user defined option should be removed.<br />
<br />
'''Comment K6<br />
<br />
According to the information on THL’s webpage, the duration of FinIP, Finnish Invasive Pneumococcal Disease Vaccine trial, is until the end of 2018. Would FinIP follow-up impact the tender? Ref. Lääkärilehti 22.8.2014, page 2017 Budjettileikkuri iskee rokotuksiin.</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33433Economic evaluation2014-08-27T11:15:24Z<p>Mnud: </p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
=== Computation ===<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. <br />
<br />
<br><br />
* <big>'''<u>Instructions for user: Choose the desired vaccine compositions and their prices and then press "Run code".</u>'''<br />
<br />
The results of the cost-effectiveness analysis will be displayed on a separate tab. </big><br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
costsum <- Total_costs<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
if (FALSE){#!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
#if (!is.null(debug_plot)) plot3<br />
#if (!is.null(debug_plot)) plot2<br />
#if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty...<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
ipdtable <- oapply(VacIPD, VacIPD@output["Vaccine"], sum)@output<br />
colnames(ipdtable)[colnames(ipdtable) == "VacIPDResult"] <- "N_of_IPD_cases"<br />
<br />
oprint(<br />
ipdtable[order(match(ipdtable$Vaccine, qorder)),],<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top",<br />
digits = rep(0, ncol(ipdtable) + 1)<br />
) <br />
<br />
##############################<br />
## print health care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine = qorder,<br />
Medical_costs = result(health_care_costs)[match(qorder,health_care_costs@output$Vaccine)] * 1e-6,<br />
Vaccine_programme_cost = result(vacprice) * 1e-6,<br />
Health_care_costs = result(costsum)[match(qorder,costsum@output$Vaccine)] * 1e-6<br />
)<br />
oprint(<br />
sum_table1A,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top",<br />
digits = c(0,0,2,2,2)<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(<br />
tekstia, <br />
include.rownames = FALSE, <br />
include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top"<br />
)<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained = QALYs_gained,<br />
Incremental_effect = QALYs_incremental,<br />
Health_care_costs = Cost_total * 1e-6,<br />
Incremental_cost = Cost_incremental * 1e-6,<br />
ICER = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top",<br />
digits = c(0,0,0,0,2,2,2)<br />
)<br />
</rcode><br />
<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Rationale == <br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER):<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
<br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Sensitivity ===<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
=== Data ===<br />
Summary table of the data applied in the cost-effectiveness analysis. Note, that the cost-effectiveness analysis is based on age-year (0-100) specific data on IPD and life years lost.<br />
<br />
1. QALY_menin = QALY losses due to meningitis incl. sequlae (in years, *)<br />
2. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
3. CFR = Case fatality ratio for meningitis and bacteremia<br />
4. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
5. Cost_ menin = Medical costs attributed to meningitis incl. sequlae (in euros *)<br />
6. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
7. Menin_proportion = Proportion of meningitis cases of all IPD cases<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
{| || {{prettytable}}<br />
|+Estimated medical costs and years lost due to a single bacteremia or meningitis episode <br />
| Age class || QALY_men || QALY_bac || CFR || Life_y_lost || COST_men || COST_bac || Menin_proportion<br />
|---<br />
| <5 years || 0.22 || 0.0079 || 0.014 || 31.1 || 22 070 || 1 986 || 0.037<br />
|---<br />
| 5-64 years || 0.16 || 0.0079 || 0.112 || 20.7 || 26 488 || 9 000 || 0.046<br />
|---<br />
| 65+ years || 0.08 || 0.0079 || 0.196 || 9.4 || 21 529 || 6 823 || 0.019<br />
|---<br />
|}<br />
* Note: The above table lists averages within each age class. Cost-effectiveness analysis is based on age year -specific values.<br />
<br />
<br><br />
<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost in Finland without vaccination (per year)<br />
|---<br />
|Age group||QALY_meningitis||QALY_bacteremia||Life_years_lost||Cost_meningitis||Cost_bacteremia<br />
|---<br />
|0-4y||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|5-64y||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|65+y||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
<br />
<br><br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Epidemiological_modelling&diff=33397Epidemiological modelling2014-08-27T10:24:53Z<p>Mnud: </p>
<hr />
<div>[[op_fi:Epidemiologinen_malli]]<br />
{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
==Question==<br />
<br />
How to predict the net effectiveness of pneumococcal conjugate vaccination with a given set of serotypes when the vaccine is included in the national immunisation programme?<br />
<br />
* The focus is on the incidence of invasive pneumococcal disease (IPD) cases in different age groups covering the whole population.<br />
* The model is assumed to be valid in a population in which pneumococcal conjugate vaccination of infants has been in place for several years so that a new steady-state after vaccination has been reached. <br />
* The coverage of vaccination and vaccine efficacy against carriage are assumed to be high enough to justify the assumption of complete elimination of vaccine-type carriage among both the vaccinated and also, due to substantial herd effects, among the unvaccinated members of the population. <br />
* Vaccine-type carriage will be completely replaced by carriage of the non-vaccine types whose disease causing potential is not altered by vaccination.<br />
<br />
==Answer==<br />
<br />
The predicted reduction in the incidence of invasive pneumococcal disease (IPD) in different age groups are obtained from the serotype replacement model <ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref>. <br />
<br />
=== Computation ===<br />
<br />
The following program illustrates the working of the replacement model. In its current implementation the code allows the user to specify upto 4 vaccine compositions and then displays the predicted ''number'' of IPD cases in Finland per year corresponding to these vaccines. The results are shown by serotype and by age category (<5 and 5+ year olds). Possible choices for vaccine compositions are: PCV10, PCV13, no vaccination and a user specified serotype composition. The program is based on the code in File S1 in <ref name="optimalserotype"></ref>.<br />
<br />
<br><br />
* <big>'''<u>Instructions for user: Choose the desired vaccine compositions from the list below and then press "Run code".</u>'''<br />
<br />
You can compare 2,3 or 4 vaccine compositions. The results will be displayed on a separate tab. The default choice is PCV10 and PCV13.</big><br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13;<br />
'No_vaccination';No vaccination|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:custom_vac|description:Do you want to specify another vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
<br />
name:vac_user|description:Choose the serotypes for the user defined vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE"<br />
><br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
#vacc1 <- vac<br />
#vacc2 <- custom_vac<br />
<br />
if(custom_vac) {<br />
vac <- c(vac, "UserDefined")<br />
}<br />
<br />
if (length(vac) == 0) stop("No vaccines were specified.")<br />
<br />
user_args <- list(<br />
Scenario = vac<br />
)<br />
<br />
# Ulkoinen säilö datalle jollain sivulla?<br />
temp <- data.frame(<br />
Vaccine = rep(c("PCV10", "PCV13"), c(9, 12)), <br />
Serotype = c('19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7', <br />
'19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7', '3', '6A', '19A'<br />
)<br />
)<br />
<br />
user_args$Vaccines <- temp[temp$Vaccine %in% user_args$Scenario, ]<br />
<br />
if(custom_vac) {<br />
user_args$Vaccines <- rbind(<br />
user_args$Vaccines, <br />
data.frame(Vaccine = "UserDefined", Serotype = vac_user)<br />
)<br />
}<br />
<br />
#if(!exists("servac_user")) servac_user <- c('19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7')<br />
<br />
<br />
<br />
objects.latest("Op_fi4305", code_name = "alusta") # [[Pneumokokkirokote]]<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
openv.setN(100)<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
serotypes<-c(<br />
"19F", "23F", "6B", "14", "9V", "4", "18C", "1", "7",<br />
"6A", "19A", "3", "8", "9N", "10", "11", "12", "15",<br />
"16", "20", "22", "23A", "33", "35", "38", "6C", "Oth")<br />
car_under5<-c(<br />
156030, 156030, 126990, 41200, 22290, 12830, 10130, 10, 14180,<br />
54940, 24320, 12160, 1350, 20940, 4050, 72270, 10, 33100,<br />
3380, 1350, 12160, 3380, 680, 30400, 4050, 27470, 24320 )<br />
car_over5<-c(<br />
168100, 314800, 256700, 209800, 114100, 62500, 200700, 100, 100,<br />
158800, 54900, 30800, 8800, 8800, 20800, 97700, 100, 100,<br />
191900, 25200, 72500, 22000, 100, 71300, 100, 79400, 330100 )<br />
ipd_under5<-c(<br />
7.78, 7.88, 24.39, 20.76, 2.91, 2.91, 6.64, 0.31, 3.02,<br />
3.94, 9.88, 1.25, 0.10, 0.83, 0.41, 0.42, 0.21, 1.98,<br />
0.21, 0.01, 0.93, 0.10, 0.42, 0.31, 0.42, 0.01, 0.73 )<br />
ipd_over5<-c(<br />
28.51, 53.72, 29.53, 99.43, 43.07, 76.99, 24.39, 6.58, 46.88,<br />
17.42, 20.54, 55.04, 11.21, 25.20, 6.28, 12.76, 13.89, 9.18,<br />
4.73, 3.29, 29.03, 4.40, 5.64, 12.41, 1.43, 5.50, 11.20 )<br />
<br />
## Combine the data into 2 matrices of dimension 27*2:<br />
IPD<-cbind(ipd_under5, ipd_over5)<br />
Car<-cbind(car_under5, car_over5)<br />
<br />
## Row numbers corresponding to the 3 different PCV formulations<br />
## in matrices IPD and Car. Note: there is no serotype 5 in our data.<br />
pcv7rows<-seq(7); pcv10rows<-seq(9); pcv13rows<-seq(12)<br />
<br />
<br />
## Example S1.2A: Calculate the predicted incidence of IPD for the non-vaccine<br />
## types(NVTs) under PCV13. The predictions are calculated separately for the<br />
## two age classes. These are the values reported on the bottom panel in<br />
## Figure 2 (there given as per 100K incidences).<br />
postvacc <-Vaccination(IPD,Car,VT_rows=pcv13rows,p=1,q=1)<br />
<br />
<br />
## Example S1.2B: Decrease in IPD incidence after adding a single new serotype<br />
## to PCV13 separately for the two age categories.<br />
next_under5<-NextVT(IPD[,1],Car[,1], VT_rows=pcv13rows,p=1)<br />
next_over5 <-NextVT(IPD[,2],Car[,2], VT_rows=pcv13rows,p=1)<br />
<br />
# Nämä taulukot kannattaisi transposata niin näyttäisivät siistimmiltä.<br />
<br />
## Example S1.3A: The optimal sequence for under 5 year olds when replacement is 100%.<br />
## The output shows the decreases in IPD incidence for each step,<br />
## corresponding to Figure 5(C). The last serotype (row 27, the category "Other")<br />
## is excluded from any vaccine composition but is taken into account as a<br />
## replacing serotype at each stage.<br />
opt<-OptimalSequence(IPD[,1],Car[,1],VT_rows=0,Excluded_rows=27,p=1.0,HowmanyAdded=20)<br />
<br />
<br />
## Example S1.3B: The optimal sequence for the whole population when<br />
## replacement is 50% and the current composition includes the PCV7 serotypes.<br />
opt<-OptimalSequence(IPD,Car, VT_rows=pcv7rows,Excluded_rows=length(serotypes),<br />
p=0.5,HowmanyAdded=17)<br />
<br />
<br />
###################################<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
servac <- merge(data.frame(Vaccine = user_args$Scenario), data.frame(Serotype = serotypes))<br />
servac <- merge(<br />
data.frame(user_args$Vaccines, Result = 1), <br />
servac, <br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
#data.frame(<br />
#Vaccine = rep(c("Current", "New"), each = length(serotypes)),<br />
#Serotype = serotypes,<br />
#Result = as.numeric(c(<br />
# serotypes %in% c("19F", "23F", "6B", "14", "9V", "4", "18C", "1", "7"),<br />
# serotypes %in% servac_user<br />
# ))<br />
#))<br />
<br />
p_user<-q_user<-adultcarriers<-1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
# The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) }<br />
<br />
<br />
<br />
<br />
if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Incidence of invasive pneumococcal disease", y = "Number of cases per year")<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Age)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Incidence of invasive pneumococcal disease", y = "Number of cases per year")<br />
<br />
</rcode><br />
<br />
<br />
=== Data ===<br />
<br />
{{hidden|<br />
<br />
<t2b name='Pneumococcal carriage and IPD _' index='Serotype,Age,Observation' locations='Carriage,IPD' unit='Number of cases per year'><br />
19F|Under 5|156030|7.78<br />
23F|Under 5|156030|7.88<br />
6B|Under 5|126990|24.39<br />
14|Under 5|41200|20.76<br />
9V|Under 5|22290|2.91<br />
4|Under 5|12830|2.91<br />
18C|Under 5|10130|6.64<br />
1|Under 5|10|0.31<br />
7|Under 5|14180|3.02<br />
6A|Under 5|54940|3.94<br />
19A|Under 5|24320|9.88<br />
3|Under 5|12160|1.25<br />
8|Under 5|1350|0.1<br />
9N|Under 5|20940|0.83<br />
10|Under 5|4050|0.41<br />
11|Under 5|72270|0.42<br />
12|Under 5|10|0.21<br />
15|Under 5|33100|1.98<br />
16|Under 5|3380|0.21<br />
20|Under 5|1350|0.01<br />
22|Under 5|12160|0.93<br />
23A|Under 5|3380|0.1<br />
33|Under 5|680|0.42<br />
35|Under 5|30400|0.31<br />
38|Under 5|4050|0.42<br />
6C|Under 5|27470|0.01<br />
Oth|Under 5|24320|0.73<br />
19F|Over 5|168100|28.51<br />
23F|Over 5|314800|53.72<br />
6B|Over 5|256700|29.53<br />
14|Over 5|209800|99.43<br />
9V|Over 5|114100|43.07<br />
4|Over 5|62500|76.99<br />
18C|Over 5|200700|24.39<br />
1|Over 5|100|6.58<br />
7|Over 5|100|46.88<br />
6A|Over 5|158800|17.42<br />
19A|Over 5|54900|20.54<br />
3|Over 5|30800|55.04<br />
8|Over 5|8800|11.21<br />
9N|Over 5|8800|25.2<br />
10|Over 5|20800|6.28<br />
11|Over 5|97700|12.76<br />
12|Over 5|100|13.89<br />
15|Over 5|100|9.18<br />
16|Over 5|191900|4.73<br />
20|Over 5|25200|3.29<br />
22|Over 5|72500|29.03<br />
23A|Over 5|22000|4.4<br />
33|Over 5|100|5.64<br />
35|Over 5|71300|12.41<br />
38|Over 5|100|1.43<br />
6C|Over 5|79400|5.5<br />
Oth|Over 5|330100|11.2<br />
</t2b><br />
<br />
<t2b name="Serotypes in typical pneumococcal vaccines" index="Vaccine" obs="Serotype" unit="-"><br />
PCV10|19F<br />
PCV10|23F<br />
PCV10|6B<br />
PCV10|14<br />
PCV10|9V<br />
PCV10|4<br />
PCV10|18C<br />
PCV10|1<br />
PCV10|7<br />
PCV13|19F<br />
PCV13|23F<br />
PCV13|6B<br />
PCV13|14<br />
PCV13|9V<br />
PCV13|4<br />
PCV13|18C<br />
PCV13|1<br />
PCV13|7<br />
PCV13|3<br />
PCV13|6A<br />
PCV13|19A<br />
Existing serotypes|19F<br />
Existing serotypes|23F<br />
Existing serotypes|6B<br />
Existing serotypes|14<br />
Existing serotypes|9V<br />
Existing serotypes|4<br />
Existing serotypes|18C<br />
Existing serotypes|1<br />
Existing serotypes|7<br />
Existing serotypes|6A<br />
Existing serotypes|19A<br />
Existing serotypes|3<br />
Existing serotypes|8<br />
Existing serotypes|9N<br />
Existing serotypes|10<br />
Existing serotypes|11<br />
Existing serotypes|12<br />
Existing serotypes|15<br />
Existing serotypes|16<br />
Existing serotypes|20<br />
Existing serotypes|22<br />
Existing serotypes|23A<br />
Existing serotypes|33<br />
Existing serotypes|35<br />
Existing serotypes|38<br />
Existing serotypes|6C<br />
Existing serotypes|Oth<br />
</t2b><br />
}}<br />
<br />
=== Initiate functions (only for developers) ===<br />
<br />
<rcode name="initiate" label="Initiate functions" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
#S1.4. The R-functions<br />
###############################################################################<br />
##<br />
## R code for the core methods introduced in<br />
## Markku Nurhonen and Kari Auranen:<br />
## "Optimal serotype compositions for pneumococcal conjugate<br />
## vaccination under serotype replacement",<br />
## PLoS Computational Biology, 2014.<br />
##<br />
###############################################################################<br />
## List of arguments common to most functions:<br />
##<br />
## IPD = matrix of IPD incidences by age class (columns) and serotype (rows)<br />
## Car = corresponding matrix of carriage incidences<br />
## VT_rows = vector of the row numbers in matrices IPD and Car<br />
## corresponding to vaccine types (VT_rows=0 for no vaccination)<br />
## p = proportion of lost VT carriage which is replaced by NVT carriage<br />
## q = proportion of VT carriage lost either due to elimination or replacement<br />
##<br />
## This code includes 4 functions:<br />
## Vaccination, NextVT, OptimalSequence and OptimalVacc.<br />
##<br />
<br />
Vaccination<-function(IPD,Car,VT_rows,p,q) {<br />
##<br />
## Result:<br />
## A list of 2 matrices: IPD and carriage incidences<br />
## after vaccination (corresponding to matrices IPD and Car).<br />
## [Markku Nurhonen 2013]<br />
##<br />
if (VT_rows[1]>0) {<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
# Post vaccination carriage incidences<br />
Car_Total<-t(matrix(apply(Car,2,sum),dim(Car)[2],dim(Car)[1]))<br />
Car2<-Car; Car2[VT_rows,]<-0<br />
Car_NVT<-t(matrix(apply(Car2,2,sum),dim(Car2)[2],dim(Car2)[1]))<br />
Car_VT<-Car_Total-Car_NVT<br />
CarNew<-q*(1+p*Car_VT/Car_NVT)*Car2+(1-q)*Car<br />
# Post vaccination IPD incidences<br />
NVT_rows<-seq(dim(IPD)[1])[-1*VT_rows]<br />
# CCR=Case-to-carrier ratios<br />
CCR<-IPD/Car ; IPDNew<-0*IPD<br />
# Apply the equation appearing above<br />
# equation (1) in text for each serotype.<br />
# First term applies to NVTs.<br />
IPDNew[VT_rows,]<-(1-q)*IPD[VT_rows,]<br />
# Second term applies to NVTs.<br />
IPDNew[NVT_rows,]<-((Car_NVT+p*q*Car_VT)*(Car/Car_NVT)*CCR)[NVT_rows,]<br />
}<br />
else {<br />
IPDNew<-IPD; CarNew<-Car<br />
}<br />
list(IPDNew,CarNew) <br />
}<br />
<br />
NextVT<-function(IPD,Car,VT_rows,p) {<br />
##<br />
## Result:<br />
## A vector of decreases in IPD due to adding a serotype<br />
## to the vaccine. If VT_rows=0, initially no vaccination.<br />
## For row indexes incuded in VT_rows, the result is 0.<br />
## [Markku Nurhonen 2013]<br />
##<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
<br />
## VaccMat = IPD and Car matrices after vaccination<br />
VaccMat<-Vaccination(IPD,Car,VT_rows,p,1)<br />
IPD<-VaccMat[[1]]; Car<-VaccMat[[2]]<br />
<br />
## Total_IPD,Total_Car = Matrices corresponding to<br />
## overall IPD and carriage in each age class.<br />
Total_IPD<-t(matrix(apply(IPD,2,sum),dim(IPD)[2],dim(IPD)[1]))<br />
Total_Car<-t(matrix(apply(Car,2,sum),dim(Car)[2],dim(Car)[1]))<br />
<br />
## Effect = decrease in IPD when one serotype is added to the vaccine.<br />
## See equation (3) in text.<br />
Effect<-(Total_IPD-IPD)*((IPD/(Total_IPD-IPD))-(p*Car/(Total_Car-Car)))<br />
<br />
## Special case when only one NVT remains.<br />
IPD_nonzero<-which(apply(IPD,1,sum)!=0)<br />
if (length(IPD_nonzero)==1) {Effect[IPD_nonzero,]<-IPD[IPD_nonzero,]}<br />
<br />
## Result is obtained after summation over age classes.<br />
apply(Effect,1,sum) <br />
}<br />
<br />
OptimalSequence<-function(IPD,Car,VT_rows,Excluded_rows,p,HowmanyAdded) {<br />
##<br />
## Starting from VTs indicated by the vector VT_rows<br />
## (VT_rows=0, for no vaccination) sequentially add new VTs<br />
## to the vaccine composition s.t. at each step the optimal<br />
## serotype (corresponding to largest decrease in IPD) is added.<br />
##<br />
## Excluded_rows = Vector of indexes of the rows in matrices<br />
## IPD and Car corresponding to serotypes that are not to<br />
## be included in a vaccine composition, e.g. a row<br />
## corresponding to a group of serotypes labelled "Other".<br />
## Enter Excluded_rows=0 for no excluded serotypes.<br />
## HowmanyAdded = number of VTs to be added.<br />
##<br />
## Result:<br />
## Matrix of dimension 2*HowmanyAdded with 1st row indicating<br />
## the row numbers of added serotypes in the order they appear<br />
## in the sequence. The 2nd row lists the decreases in IPD<br />
## due to addition of each type. [Markku Nurhonen 2013]<br />
##<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
## First check the maximum possible number of added VTs.<br />
VT_howmany<-length(VT_rows)<br />
if (VT_rows[1]==0) {VT_howmany<-0}<br />
Excluded_howmany<-length(Excluded_rows)<br />
if (Excluded_rows[1]==0) {Excluded_howmany<-0}<br />
HowmanyAdded<-min(HowmanyAdded,dim(IPD)[1]-(VT_howmany+Excluded_howmany))<br />
BestVTs<-BestEffects<-rep(0,HowmanyAdded)<br />
## Sequential procedure: at each step find the best additional VT.<br />
for (i in 1:HowmanyAdded) {<br />
## Effects = Decrease in IPD after addition of each serotype<br />
Effects<-NextVT(IPD,Car,VT_rows,p)<br />
## Set Effects for VTs and excluded types equal to small values<br />
## so that none of these will be selected as the next VT.<br />
minvalue<- -2*max(abs(Effects))<br />
if (Excluded_howmany>0) {Effects[Excluded_rows]<-minvalue}<br />
if (VT_rows[1]>0) {Effects[VT_rows]<-minvalue}<br />
## BestVTs[i] = Index of serotype with maximum decrease in IPD.<br />
BestVTs[i]<-order(-1*Effects)[1]<br />
## BestEffects[i] = Decrese in IPD due to addition of BestVTs[i]<br />
## to the vaccine.<br />
BestEffects[i]<-Effects[BestVTs[i]]<br />
VT_rows<-c(VT_rows,BestVTs[i])<br />
if (VT_rows[1]==0) {VT_rows<-VT_rows[-1]}<br />
VaccMat<-Vaccination(IPD,Car,VT_rows,p,1)<br />
IPD<-VaccMat[[1]]; Car<-VaccMat[[2]] <br />
}<br />
t(matrix(c(BestVTs,BestEffects),HowmanyAdded,2)) <br />
}<br />
<br />
OptimalVacc<-function(IPD,Car,VT_rows,p,q,HowmanyAdded) {<br />
##<br />
## Result:<br />
## A list of 3 elements: (1) Row numbers of serotypes in the optimal<br />
## vaccine composition (2)-(3) IPD and carriage incidences<br />
## by serotype and age class corresponding to the optimal<br />
## vaccine formed using the sequential procedure in the<br />
## function OptimalSequence. [Markku Nurhonen 2013]<br />
##<br />
Additional_VTs<-OptimalSequence(IPD,Car,VT_rows,p,HowmanyAdded)[1,]<br />
All_VTs<-c(VT_rows,Additional_VTs)<br />
if (All_VTs[1]==0) All_VTs<-All_VTs[-1]<br />
VaccMat<-Vaccination(IPD,Car,All_VTs,p,q)<br />
list(All_VTs,VaccMat[[1]],VaccMat[[2]]) <br />
}<br />
<br />
VacCar <- Ovariable("VacCar",<br />
dependencies = data.frame(Name = c(<br />
"IPD", # incidence of pneumococcus disease<br />
"Car", # number of carriers of pneumococcus<br />
"servac", # ovariable of serotypes in vaccine (1 for serotypes in a vaccine, otherwise result is 0)<br />
"p", # proportion of eliminated VT carriage that is replaced by NVT carriage<br />
"q" # proportion of of VT carriage eliminated by vaccine<br />
)), <br />
formula = function(...) {<br />
## Result:<br />
## An ovariable of carriage incidences<br />
## after vaccination (corresponding to Car).<br />
## [Markku Nurhonen 2013, Jouni Tuomisto 2014]<br />
# Post vaccination carriage incidences<br />
<br />
# Sum over serotypes and drop extra columns<br />
#Car_Total<- unkeep(oapply(Car, cols = "Serotype", FUN = sum) * 1, prevresults = TRUE)<br />
# Car2 is a temporary ovariable with NVT carriers only<br />
#Car2 <- unkeep(Car * (1 - servac), prevresults = TRUE) # Take only NVT carriers<br />
<br />
#Car_NVT <- oapply(Car2, cols = "Serotype", FUN = sum) # Carriers of serotypes not in vaccine (NVT)<br />
#Car_VT <- Car_Total - Car_NVT # Carriers of vaccine serotypes<br />
<br />
#CarNew <- q * (1 + p * Car_VT / Car_NVT) * Car2 + (1 - q) * Car<br />
<br />
eliminated <- q * servac * Car<br />
eliminated <- unkeep(eliminated, prevresults = TRUE)<br />
<br />
replaced <- oapply(eliminated, NULL, sum, "Serotype") * p<br />
# Distribute increase evenly among non-vaccine serotypes<br />
replaced <- unkeep(1 - servac, prevresults = TRUE) / <br />
oapply(unkeep(1 - servac, prevresults = TRUE), NULL, sum, "Serotype") * <br />
replaced<br />
<br />
replaced <- unkeep(replaced, prevresults = TRUE)<br />
<br />
CarNew <- Car - eliminated + replaced<br />
return(CarNew)<br />
}<br />
)<br />
<br />
VacIPD <- Ovariable("VacIPD",<br />
dependencies = data.frame(Name = c(<br />
"IPD", # incidence of pneumococcus disease<br />
"Car", # number of carriers of pneumococcus<br />
"servac", # ovariable of serotypes in vaccine (1 for serotypes in a vaccine, otherwise result is 0)<br />
"p", # proportion of eliminated VT carriage that is replaced by NVT carriage<br />
"q" # proportion of of VT carriage eliminated by vaccine<br />
#"VacCar" # proportional serotype carriage after vaccination<br />
)), <br />
formula = function(...) {<br />
## Result:<br />
## An ovariable of IPD incidence<br />
## after vaccination (corresponding to ovariable IPD).<br />
## [Markku Nurhonen 2013, Jouni Tuomisto 2014]<br />
<br />
# Post vaccination carriage incidences (same code as in VacCar)<br />
<br />
#Car_Total <- unkeep(oapply(Car, cols = "Serotype", FUN = sum) * 1, prevresults = TRUE) # Sums over serotypes<br />
#Car2 <- unkeep(Car * (1 - servac), prevresults = TRUE)<br />
<br />
#Car_NVT <- oapply(Car2, cols = "Serotype", FUN = sum) # Carriers of serotypes not in vaccine (NVT)<br />
#Car_VT <- Car_Total - Car_NVT # Carriers of vaccine serotypes<br />
#CarNew <- q * (1 + p * Car_VT / Car_NVT) * Car2 + (1 - q) * Car<br />
<br />
# Post vaccination IPD incidences<br />
# CCR=Case-to-carrier ratios<br />
#CCR <- IPD / Car<br />
<br />
# Apply the equation appearing above<br />
# equation (1) in text for each serotype.<br />
# First term applies to VTs.<br />
#IPDNewVT <- (1 - q) * IPD * servac<br />
<br />
# Second term applies to NVTs.<br />
#IPDNewNVT <- (Car_NVT + p * q * Car_VT) * (Car / Car_NVT) * CCR * (1 - servac)<br />
<br />
#IPDNew <- IPDNewVT + IPDNewNVT<br />
<br />
#IPDNew <- IPD * unkeep(VacCar, prevresults = TRUE) / Car<br />
#IPDNew <- IPD * exp(unkeep(log(VacCar), prevresults = TRUE) - unkeep(log(Car), prevresults = TRUE))<br />
<br />
eliminated <- q * servac * Car<br />
eliminated <- unkeep(eliminated, prevresults = TRUE)<br />
<br />
replaced <- oapply(eliminated, NULL, sum, "Serotype") * p<br />
# Distribute increase evenly among non-vaccine serotypes<br />
#replaced <- unkeep(1 - servac, prevresults = TRUE) / <br />
# oapply(1 - servac, NULL, sum, "Serotype") * <br />
# replaced<br />
<br />
replaced <- unkeep(replaced, prevresults = TRUE)<br />
<br />
IPDNew <- ((1 - q * servac) + (1 - servac) * replaced / oapply((1 - servac) * Car, NULL, sum, "Serotype")) * IPD <br />
#oapply(IPDNew, IPDNew@output$Vaccine, sum)<br />
<br />
return(IPDNew) <br />
}<br />
)<br />
<br />
objects.store(Vaccination, NextVT, OptimalSequence, OptimalVacc, VacCar, VacIPD)<br />
<br />
cat("the functions Vaccination, NextVT, OptimalSequence, OptimalVacc and the ovariables VacCar, VacIPD are now saved. \n")<br />
<br />
</rcode><br />
<br />
<br />
==Rationale==<br />
<br />
The epidemiological model for pneumococcal carriage and disease is based on the assumption that vaccination completely eliminates vaccine-type carriage in the vaccinated population and that vaccine-type carriage is completely replaced by non-vaccine-type carriage. The implications of this replacement on the decrease or increase in pneumococcal disease then depend on the disease causing potential of the replacing types compared to that of the replaced types. To predict the incidence of post-vaccination disease only pre-vaccination data on serotype-specific carriage and disease are used.<br />
<br />
The consequences of serotype replacement in the model depend on two key assumptions regarding the new steady-state after vaccination:<br />
# the relative serotype proportions among the non-vaccine types are not affected by vaccination (proportionality assumption);<br />
# the case-to-carrier ratios (the disease causing potentials) of individual serotypes remain at their pre-vaccination levels.<br />
<br />
The implications of vaccination on disease incidence are assumed to be solely due to the elimination of vaccine type carriage and its replacement by non vaccine-type carriage. An exception to this is when protective efficacy against disease without any efficacy against carriage is assumed for certain serotypes (a feature to be added).<br />
<br />
<br />
<br><br />
<br><br />
<br />
[[File:Model_kuva_simplified2.jpg|thumb|center|600px|'''Figure 1. Illustration of the replacement model.''' The incidence of pneumococcal carriage (x-axis) and case-to-carrier ratios (y-axis) for vaccine serotypes (VT) and non-vaccine serotypes (NVT) before (panel A) and after vaccination (panel B). The incidences of disease (DVT and DNVT) are obtained by multiplication of the two quantities and correspond to the areas of the rectangles. After vaccination, VT carriage is eliminated and replaced by NVT carriage (panel B). The decrease in IPD incidence after vaccination is obtained as the difference between the eliminated VT disease and the replacing NVT disease. This is the area of the blue rectangle in panel B.]]<br />
<br />
<br />
<br><br />
'''Related research'''<br><br />
The replacement model was built to reflect the accumulated 15 year long experience on use of pneumococcal conjugate vaccines worldwide and the related scientific research activity. Some of the most recent relevant publications are listed on a separate page: [[References]].<br />
<br />
'''Sensitivity analysis'''<br><br />
To assess the sensitivity of the predictions produced by the epidemiological model, <br />
effects of some alternative scenarios regarding the role of certain serotypes in PCV10 and PCV13 were calculated. <br />
In particular, these scenarios concern assumptions about indirect protection against serotype 3 under PCV13, <br />
indirect protection against serotype 6A under PCV10, and direct protection against 19A in PCV10. The detailed results are <br />
reported on a separate page: [[Sensitivity_analysis_pcv_model]]. In summary, the most influential assumptions are whether or not there will be population-level (indirect) impact on serotype 3 disease under PCV13 and serotype 6A disease under PCV10. <br />
<br />
<br><br />
<br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Epidemiological_modelling&diff=33393Epidemiological modelling2014-08-27T10:20:15Z<p>Mnud: </p>
<hr />
<div>[[op_fi:Epidemiologinen_malli]]<br />
{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
==Question==<br />
<br />
How to predict the net effectiveness of pneumococcal conjugate vaccination with a given set of serotypes when the vaccine is included in the national immunisation programme?<br />
<br />
* The focus is on the incidence of invasive pneumococcal disease (IPD) cases in different age groups covering the whole population.<br />
* The model is assumed to be valid in a population in which pneumococcal conjugate vaccination of infants has been in place for several years so that a new steady-state after vaccination has been reached. <br />
* The coverage of vaccination and vaccine efficacy against carriage are assumed to be high enough to justify the assumption of complete elimination of vaccine-type carriage among both the vaccinated and also, due to substantial herd effects, among the unvaccinated members of the population. <br />
* Vaccine-type carriage will be completely replaced by carriage of the non-vaccine types whose disease causing potential is not altered by vaccination.<br />
<br />
==Answer==<br />
<br />
The predicted reduction in the incidence of invasive pneumococcal disease (IPD) in different age groups are obtained from the serotype replacement model <ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref>. <br />
<br />
=== Computation ===<br />
<br />
The following program illustrates the working of the replacement model. In its current implementation the code allows the user to specify upto 4 vaccine compositions and then displays the predicted ''number'' of IPD cases in Finland per year corresponding to these vaccines. The results are shown by serotype and by age category (<5 and 5+ year olds). Possible choices for vaccine compositions are: PCV10, PCV13, no vaccination and a user specified serotype composition. The program is based on the code in File S1 in <ref name="optimalserotype"></ref>.<br />
<br />
<br><br />
'''Instructions for user: Choose the desired vaccine compositions from the list below and then press "Run code".'''<br />
<br />
You can compare 2,3 or 4 vaccine compositions. The results will be displayed on a separate tab. The default choice is PCV10 and PCV13.<br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13;<br />
'No_vaccination';No vaccination|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:custom_vac|description:Do you want to specify another vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
<br />
name:vac_user|description:Choose the serotypes for the user defined vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE"<br />
><br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
#vacc1 <- vac<br />
#vacc2 <- custom_vac<br />
<br />
if(custom_vac) {<br />
vac <- c(vac, "UserDefined")<br />
}<br />
<br />
if (length(vac) == 0) stop("No vaccines were specified.")<br />
<br />
user_args <- list(<br />
Scenario = vac<br />
)<br />
<br />
# Ulkoinen säilö datalle jollain sivulla?<br />
temp <- data.frame(<br />
Vaccine = rep(c("PCV10", "PCV13"), c(9, 12)), <br />
Serotype = c('19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7', <br />
'19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7', '3', '6A', '19A'<br />
)<br />
)<br />
<br />
user_args$Vaccines <- temp[temp$Vaccine %in% user_args$Scenario, ]<br />
<br />
if(custom_vac) {<br />
user_args$Vaccines <- rbind(<br />
user_args$Vaccines, <br />
data.frame(Vaccine = "UserDefined", Serotype = vac_user)<br />
)<br />
}<br />
<br />
#if(!exists("servac_user")) servac_user <- c('19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7')<br />
<br />
<br />
<br />
objects.latest("Op_fi4305", code_name = "alusta") # [[Pneumokokkirokote]]<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
openv.setN(100)<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
serotypes<-c(<br />
"19F", "23F", "6B", "14", "9V", "4", "18C", "1", "7",<br />
"6A", "19A", "3", "8", "9N", "10", "11", "12", "15",<br />
"16", "20", "22", "23A", "33", "35", "38", "6C", "Oth")<br />
car_under5<-c(<br />
156030, 156030, 126990, 41200, 22290, 12830, 10130, 10, 14180,<br />
54940, 24320, 12160, 1350, 20940, 4050, 72270, 10, 33100,<br />
3380, 1350, 12160, 3380, 680, 30400, 4050, 27470, 24320 )<br />
car_over5<-c(<br />
168100, 314800, 256700, 209800, 114100, 62500, 200700, 100, 100,<br />
158800, 54900, 30800, 8800, 8800, 20800, 97700, 100, 100,<br />
191900, 25200, 72500, 22000, 100, 71300, 100, 79400, 330100 )<br />
ipd_under5<-c(<br />
7.78, 7.88, 24.39, 20.76, 2.91, 2.91, 6.64, 0.31, 3.02,<br />
3.94, 9.88, 1.25, 0.10, 0.83, 0.41, 0.42, 0.21, 1.98,<br />
0.21, 0.01, 0.93, 0.10, 0.42, 0.31, 0.42, 0.01, 0.73 )<br />
ipd_over5<-c(<br />
28.51, 53.72, 29.53, 99.43, 43.07, 76.99, 24.39, 6.58, 46.88,<br />
17.42, 20.54, 55.04, 11.21, 25.20, 6.28, 12.76, 13.89, 9.18,<br />
4.73, 3.29, 29.03, 4.40, 5.64, 12.41, 1.43, 5.50, 11.20 )<br />
<br />
## Combine the data into 2 matrices of dimension 27*2:<br />
IPD<-cbind(ipd_under5, ipd_over5)<br />
Car<-cbind(car_under5, car_over5)<br />
<br />
## Row numbers corresponding to the 3 different PCV formulations<br />
## in matrices IPD and Car. Note: there is no serotype 5 in our data.<br />
pcv7rows<-seq(7); pcv10rows<-seq(9); pcv13rows<-seq(12)<br />
<br />
<br />
## Example S1.2A: Calculate the predicted incidence of IPD for the non-vaccine<br />
## types(NVTs) under PCV13. The predictions are calculated separately for the<br />
## two age classes. These are the values reported on the bottom panel in<br />
## Figure 2 (there given as per 100K incidences).<br />
postvacc <-Vaccination(IPD,Car,VT_rows=pcv13rows,p=1,q=1)<br />
<br />
<br />
## Example S1.2B: Decrease in IPD incidence after adding a single new serotype<br />
## to PCV13 separately for the two age categories.<br />
next_under5<-NextVT(IPD[,1],Car[,1], VT_rows=pcv13rows,p=1)<br />
next_over5 <-NextVT(IPD[,2],Car[,2], VT_rows=pcv13rows,p=1)<br />
<br />
# Nämä taulukot kannattaisi transposata niin näyttäisivät siistimmiltä.<br />
<br />
## Example S1.3A: The optimal sequence for under 5 year olds when replacement is 100%.<br />
## The output shows the decreases in IPD incidence for each step,<br />
## corresponding to Figure 5(C). The last serotype (row 27, the category "Other")<br />
## is excluded from any vaccine composition but is taken into account as a<br />
## replacing serotype at each stage.<br />
opt<-OptimalSequence(IPD[,1],Car[,1],VT_rows=0,Excluded_rows=27,p=1.0,HowmanyAdded=20)<br />
<br />
<br />
## Example S1.3B: The optimal sequence for the whole population when<br />
## replacement is 50% and the current composition includes the PCV7 serotypes.<br />
opt<-OptimalSequence(IPD,Car, VT_rows=pcv7rows,Excluded_rows=length(serotypes),<br />
p=0.5,HowmanyAdded=17)<br />
<br />
<br />
###################################<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
servac <- merge(data.frame(Vaccine = user_args$Scenario), data.frame(Serotype = serotypes))<br />
servac <- merge(<br />
data.frame(user_args$Vaccines, Result = 1), <br />
servac, <br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
#data.frame(<br />
#Vaccine = rep(c("Current", "New"), each = length(serotypes)),<br />
#Serotype = serotypes,<br />
#Result = as.numeric(c(<br />
# serotypes %in% c("19F", "23F", "6B", "14", "9V", "4", "18C", "1", "7"),<br />
# serotypes %in% servac_user<br />
# ))<br />
#))<br />
<br />
p_user<-q_user<-adultcarriers<-1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
# The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) }<br />
<br />
<br />
<br />
<br />
if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Incidence of invasive pneumococcal disease", y = "Number of cases per year")<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Age)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Incidence of invasive pneumococcal disease", y = "Number of cases per year")<br />
<br />
</rcode><br />
<br />
<br />
=== Data ===<br />
<br />
{{hidden|<br />
<br />
<t2b name='Pneumococcal carriage and IPD _' index='Serotype,Age,Observation' locations='Carriage,IPD' unit='Number of cases per year'><br />
19F|Under 5|156030|7.78<br />
23F|Under 5|156030|7.88<br />
6B|Under 5|126990|24.39<br />
14|Under 5|41200|20.76<br />
9V|Under 5|22290|2.91<br />
4|Under 5|12830|2.91<br />
18C|Under 5|10130|6.64<br />
1|Under 5|10|0.31<br />
7|Under 5|14180|3.02<br />
6A|Under 5|54940|3.94<br />
19A|Under 5|24320|9.88<br />
3|Under 5|12160|1.25<br />
8|Under 5|1350|0.1<br />
9N|Under 5|20940|0.83<br />
10|Under 5|4050|0.41<br />
11|Under 5|72270|0.42<br />
12|Under 5|10|0.21<br />
15|Under 5|33100|1.98<br />
16|Under 5|3380|0.21<br />
20|Under 5|1350|0.01<br />
22|Under 5|12160|0.93<br />
23A|Under 5|3380|0.1<br />
33|Under 5|680|0.42<br />
35|Under 5|30400|0.31<br />
38|Under 5|4050|0.42<br />
6C|Under 5|27470|0.01<br />
Oth|Under 5|24320|0.73<br />
19F|Over 5|168100|28.51<br />
23F|Over 5|314800|53.72<br />
6B|Over 5|256700|29.53<br />
14|Over 5|209800|99.43<br />
9V|Over 5|114100|43.07<br />
4|Over 5|62500|76.99<br />
18C|Over 5|200700|24.39<br />
1|Over 5|100|6.58<br />
7|Over 5|100|46.88<br />
6A|Over 5|158800|17.42<br />
19A|Over 5|54900|20.54<br />
3|Over 5|30800|55.04<br />
8|Over 5|8800|11.21<br />
9N|Over 5|8800|25.2<br />
10|Over 5|20800|6.28<br />
11|Over 5|97700|12.76<br />
12|Over 5|100|13.89<br />
15|Over 5|100|9.18<br />
16|Over 5|191900|4.73<br />
20|Over 5|25200|3.29<br />
22|Over 5|72500|29.03<br />
23A|Over 5|22000|4.4<br />
33|Over 5|100|5.64<br />
35|Over 5|71300|12.41<br />
38|Over 5|100|1.43<br />
6C|Over 5|79400|5.5<br />
Oth|Over 5|330100|11.2<br />
</t2b><br />
<br />
<t2b name="Serotypes in typical pneumococcal vaccines" index="Vaccine" obs="Serotype" unit="-"><br />
PCV10|19F<br />
PCV10|23F<br />
PCV10|6B<br />
PCV10|14<br />
PCV10|9V<br />
PCV10|4<br />
PCV10|18C<br />
PCV10|1<br />
PCV10|7<br />
PCV13|19F<br />
PCV13|23F<br />
PCV13|6B<br />
PCV13|14<br />
PCV13|9V<br />
PCV13|4<br />
PCV13|18C<br />
PCV13|1<br />
PCV13|7<br />
PCV13|3<br />
PCV13|6A<br />
PCV13|19A<br />
Existing serotypes|19F<br />
Existing serotypes|23F<br />
Existing serotypes|6B<br />
Existing serotypes|14<br />
Existing serotypes|9V<br />
Existing serotypes|4<br />
Existing serotypes|18C<br />
Existing serotypes|1<br />
Existing serotypes|7<br />
Existing serotypes|6A<br />
Existing serotypes|19A<br />
Existing serotypes|3<br />
Existing serotypes|8<br />
Existing serotypes|9N<br />
Existing serotypes|10<br />
Existing serotypes|11<br />
Existing serotypes|12<br />
Existing serotypes|15<br />
Existing serotypes|16<br />
Existing serotypes|20<br />
Existing serotypes|22<br />
Existing serotypes|23A<br />
Existing serotypes|33<br />
Existing serotypes|35<br />
Existing serotypes|38<br />
Existing serotypes|6C<br />
Existing serotypes|Oth<br />
</t2b><br />
}}<br />
<br />
=== Initiate functions (only for developers) ===<br />
<br />
<rcode name="initiate" label="Initiate functions" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
#S1.4. The R-functions<br />
###############################################################################<br />
##<br />
## R code for the core methods introduced in<br />
## Markku Nurhonen and Kari Auranen:<br />
## "Optimal serotype compositions for pneumococcal conjugate<br />
## vaccination under serotype replacement",<br />
## PLoS Computational Biology, 2014.<br />
##<br />
###############################################################################<br />
## List of arguments common to most functions:<br />
##<br />
## IPD = matrix of IPD incidences by age class (columns) and serotype (rows)<br />
## Car = corresponding matrix of carriage incidences<br />
## VT_rows = vector of the row numbers in matrices IPD and Car<br />
## corresponding to vaccine types (VT_rows=0 for no vaccination)<br />
## p = proportion of lost VT carriage which is replaced by NVT carriage<br />
## q = proportion of VT carriage lost either due to elimination or replacement<br />
##<br />
## This code includes 4 functions:<br />
## Vaccination, NextVT, OptimalSequence and OptimalVacc.<br />
##<br />
<br />
Vaccination<-function(IPD,Car,VT_rows,p,q) {<br />
##<br />
## Result:<br />
## A list of 2 matrices: IPD and carriage incidences<br />
## after vaccination (corresponding to matrices IPD and Car).<br />
## [Markku Nurhonen 2013]<br />
##<br />
if (VT_rows[1]>0) {<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
# Post vaccination carriage incidences<br />
Car_Total<-t(matrix(apply(Car,2,sum),dim(Car)[2],dim(Car)[1]))<br />
Car2<-Car; Car2[VT_rows,]<-0<br />
Car_NVT<-t(matrix(apply(Car2,2,sum),dim(Car2)[2],dim(Car2)[1]))<br />
Car_VT<-Car_Total-Car_NVT<br />
CarNew<-q*(1+p*Car_VT/Car_NVT)*Car2+(1-q)*Car<br />
# Post vaccination IPD incidences<br />
NVT_rows<-seq(dim(IPD)[1])[-1*VT_rows]<br />
# CCR=Case-to-carrier ratios<br />
CCR<-IPD/Car ; IPDNew<-0*IPD<br />
# Apply the equation appearing above<br />
# equation (1) in text for each serotype.<br />
# First term applies to NVTs.<br />
IPDNew[VT_rows,]<-(1-q)*IPD[VT_rows,]<br />
# Second term applies to NVTs.<br />
IPDNew[NVT_rows,]<-((Car_NVT+p*q*Car_VT)*(Car/Car_NVT)*CCR)[NVT_rows,]<br />
}<br />
else {<br />
IPDNew<-IPD; CarNew<-Car<br />
}<br />
list(IPDNew,CarNew) <br />
}<br />
<br />
NextVT<-function(IPD,Car,VT_rows,p) {<br />
##<br />
## Result:<br />
## A vector of decreases in IPD due to adding a serotype<br />
## to the vaccine. If VT_rows=0, initially no vaccination.<br />
## For row indexes incuded in VT_rows, the result is 0.<br />
## [Markku Nurhonen 2013]<br />
##<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
<br />
## VaccMat = IPD and Car matrices after vaccination<br />
VaccMat<-Vaccination(IPD,Car,VT_rows,p,1)<br />
IPD<-VaccMat[[1]]; Car<-VaccMat[[2]]<br />
<br />
## Total_IPD,Total_Car = Matrices corresponding to<br />
## overall IPD and carriage in each age class.<br />
Total_IPD<-t(matrix(apply(IPD,2,sum),dim(IPD)[2],dim(IPD)[1]))<br />
Total_Car<-t(matrix(apply(Car,2,sum),dim(Car)[2],dim(Car)[1]))<br />
<br />
## Effect = decrease in IPD when one serotype is added to the vaccine.<br />
## See equation (3) in text.<br />
Effect<-(Total_IPD-IPD)*((IPD/(Total_IPD-IPD))-(p*Car/(Total_Car-Car)))<br />
<br />
## Special case when only one NVT remains.<br />
IPD_nonzero<-which(apply(IPD,1,sum)!=0)<br />
if (length(IPD_nonzero)==1) {Effect[IPD_nonzero,]<-IPD[IPD_nonzero,]}<br />
<br />
## Result is obtained after summation over age classes.<br />
apply(Effect,1,sum) <br />
}<br />
<br />
OptimalSequence<-function(IPD,Car,VT_rows,Excluded_rows,p,HowmanyAdded) {<br />
##<br />
## Starting from VTs indicated by the vector VT_rows<br />
## (VT_rows=0, for no vaccination) sequentially add new VTs<br />
## to the vaccine composition s.t. at each step the optimal<br />
## serotype (corresponding to largest decrease in IPD) is added.<br />
##<br />
## Excluded_rows = Vector of indexes of the rows in matrices<br />
## IPD and Car corresponding to serotypes that are not to<br />
## be included in a vaccine composition, e.g. a row<br />
## corresponding to a group of serotypes labelled "Other".<br />
## Enter Excluded_rows=0 for no excluded serotypes.<br />
## HowmanyAdded = number of VTs to be added.<br />
##<br />
## Result:<br />
## Matrix of dimension 2*HowmanyAdded with 1st row indicating<br />
## the row numbers of added serotypes in the order they appear<br />
## in the sequence. The 2nd row lists the decreases in IPD<br />
## due to addition of each type. [Markku Nurhonen 2013]<br />
##<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
## First check the maximum possible number of added VTs.<br />
VT_howmany<-length(VT_rows)<br />
if (VT_rows[1]==0) {VT_howmany<-0}<br />
Excluded_howmany<-length(Excluded_rows)<br />
if (Excluded_rows[1]==0) {Excluded_howmany<-0}<br />
HowmanyAdded<-min(HowmanyAdded,dim(IPD)[1]-(VT_howmany+Excluded_howmany))<br />
BestVTs<-BestEffects<-rep(0,HowmanyAdded)<br />
## Sequential procedure: at each step find the best additional VT.<br />
for (i in 1:HowmanyAdded) {<br />
## Effects = Decrease in IPD after addition of each serotype<br />
Effects<-NextVT(IPD,Car,VT_rows,p)<br />
## Set Effects for VTs and excluded types equal to small values<br />
## so that none of these will be selected as the next VT.<br />
minvalue<- -2*max(abs(Effects))<br />
if (Excluded_howmany>0) {Effects[Excluded_rows]<-minvalue}<br />
if (VT_rows[1]>0) {Effects[VT_rows]<-minvalue}<br />
## BestVTs[i] = Index of serotype with maximum decrease in IPD.<br />
BestVTs[i]<-order(-1*Effects)[1]<br />
## BestEffects[i] = Decrese in IPD due to addition of BestVTs[i]<br />
## to the vaccine.<br />
BestEffects[i]<-Effects[BestVTs[i]]<br />
VT_rows<-c(VT_rows,BestVTs[i])<br />
if (VT_rows[1]==0) {VT_rows<-VT_rows[-1]}<br />
VaccMat<-Vaccination(IPD,Car,VT_rows,p,1)<br />
IPD<-VaccMat[[1]]; Car<-VaccMat[[2]] <br />
}<br />
t(matrix(c(BestVTs,BestEffects),HowmanyAdded,2)) <br />
}<br />
<br />
OptimalVacc<-function(IPD,Car,VT_rows,p,q,HowmanyAdded) {<br />
##<br />
## Result:<br />
## A list of 3 elements: (1) Row numbers of serotypes in the optimal<br />
## vaccine composition (2)-(3) IPD and carriage incidences<br />
## by serotype and age class corresponding to the optimal<br />
## vaccine formed using the sequential procedure in the<br />
## function OptimalSequence. [Markku Nurhonen 2013]<br />
##<br />
Additional_VTs<-OptimalSequence(IPD,Car,VT_rows,p,HowmanyAdded)[1,]<br />
All_VTs<-c(VT_rows,Additional_VTs)<br />
if (All_VTs[1]==0) All_VTs<-All_VTs[-1]<br />
VaccMat<-Vaccination(IPD,Car,All_VTs,p,q)<br />
list(All_VTs,VaccMat[[1]],VaccMat[[2]]) <br />
}<br />
<br />
VacCar <- Ovariable("VacCar",<br />
dependencies = data.frame(Name = c(<br />
"IPD", # incidence of pneumococcus disease<br />
"Car", # number of carriers of pneumococcus<br />
"servac", # ovariable of serotypes in vaccine (1 for serotypes in a vaccine, otherwise result is 0)<br />
"p", # proportion of eliminated VT carriage that is replaced by NVT carriage<br />
"q" # proportion of of VT carriage eliminated by vaccine<br />
)), <br />
formula = function(...) {<br />
## Result:<br />
## An ovariable of carriage incidences<br />
## after vaccination (corresponding to Car).<br />
## [Markku Nurhonen 2013, Jouni Tuomisto 2014]<br />
# Post vaccination carriage incidences<br />
<br />
# Sum over serotypes and drop extra columns<br />
#Car_Total<- unkeep(oapply(Car, cols = "Serotype", FUN = sum) * 1, prevresults = TRUE)<br />
# Car2 is a temporary ovariable with NVT carriers only<br />
#Car2 <- unkeep(Car * (1 - servac), prevresults = TRUE) # Take only NVT carriers<br />
<br />
#Car_NVT <- oapply(Car2, cols = "Serotype", FUN = sum) # Carriers of serotypes not in vaccine (NVT)<br />
#Car_VT <- Car_Total - Car_NVT # Carriers of vaccine serotypes<br />
<br />
#CarNew <- q * (1 + p * Car_VT / Car_NVT) * Car2 + (1 - q) * Car<br />
<br />
eliminated <- q * servac * Car<br />
eliminated <- unkeep(eliminated, prevresults = TRUE)<br />
<br />
replaced <- oapply(eliminated, NULL, sum, "Serotype") * p<br />
# Distribute increase evenly among non-vaccine serotypes<br />
replaced <- unkeep(1 - servac, prevresults = TRUE) / <br />
oapply(unkeep(1 - servac, prevresults = TRUE), NULL, sum, "Serotype") * <br />
replaced<br />
<br />
replaced <- unkeep(replaced, prevresults = TRUE)<br />
<br />
CarNew <- Car - eliminated + replaced<br />
return(CarNew)<br />
}<br />
)<br />
<br />
VacIPD <- Ovariable("VacIPD",<br />
dependencies = data.frame(Name = c(<br />
"IPD", # incidence of pneumococcus disease<br />
"Car", # number of carriers of pneumococcus<br />
"servac", # ovariable of serotypes in vaccine (1 for serotypes in a vaccine, otherwise result is 0)<br />
"p", # proportion of eliminated VT carriage that is replaced by NVT carriage<br />
"q" # proportion of of VT carriage eliminated by vaccine<br />
#"VacCar" # proportional serotype carriage after vaccination<br />
)), <br />
formula = function(...) {<br />
## Result:<br />
## An ovariable of IPD incidence<br />
## after vaccination (corresponding to ovariable IPD).<br />
## [Markku Nurhonen 2013, Jouni Tuomisto 2014]<br />
<br />
# Post vaccination carriage incidences (same code as in VacCar)<br />
<br />
#Car_Total <- unkeep(oapply(Car, cols = "Serotype", FUN = sum) * 1, prevresults = TRUE) # Sums over serotypes<br />
#Car2 <- unkeep(Car * (1 - servac), prevresults = TRUE)<br />
<br />
#Car_NVT <- oapply(Car2, cols = "Serotype", FUN = sum) # Carriers of serotypes not in vaccine (NVT)<br />
#Car_VT <- Car_Total - Car_NVT # Carriers of vaccine serotypes<br />
#CarNew <- q * (1 + p * Car_VT / Car_NVT) * Car2 + (1 - q) * Car<br />
<br />
# Post vaccination IPD incidences<br />
# CCR=Case-to-carrier ratios<br />
#CCR <- IPD / Car<br />
<br />
# Apply the equation appearing above<br />
# equation (1) in text for each serotype.<br />
# First term applies to VTs.<br />
#IPDNewVT <- (1 - q) * IPD * servac<br />
<br />
# Second term applies to NVTs.<br />
#IPDNewNVT <- (Car_NVT + p * q * Car_VT) * (Car / Car_NVT) * CCR * (1 - servac)<br />
<br />
#IPDNew <- IPDNewVT + IPDNewNVT<br />
<br />
#IPDNew <- IPD * unkeep(VacCar, prevresults = TRUE) / Car<br />
#IPDNew <- IPD * exp(unkeep(log(VacCar), prevresults = TRUE) - unkeep(log(Car), prevresults = TRUE))<br />
<br />
eliminated <- q * servac * Car<br />
eliminated <- unkeep(eliminated, prevresults = TRUE)<br />
<br />
replaced <- oapply(eliminated, NULL, sum, "Serotype") * p<br />
# Distribute increase evenly among non-vaccine serotypes<br />
#replaced <- unkeep(1 - servac, prevresults = TRUE) / <br />
# oapply(1 - servac, NULL, sum, "Serotype") * <br />
# replaced<br />
<br />
replaced <- unkeep(replaced, prevresults = TRUE)<br />
<br />
IPDNew <- ((1 - q * servac) + (1 - servac) * replaced / oapply((1 - servac) * Car, NULL, sum, "Serotype")) * IPD <br />
#oapply(IPDNew, IPDNew@output$Vaccine, sum)<br />
<br />
return(IPDNew) <br />
}<br />
)<br />
<br />
objects.store(Vaccination, NextVT, OptimalSequence, OptimalVacc, VacCar, VacIPD)<br />
<br />
cat("the functions Vaccination, NextVT, OptimalSequence, OptimalVacc and the ovariables VacCar, VacIPD are now saved. \n")<br />
<br />
</rcode><br />
<br />
<br />
==Rationale==<br />
<br />
The epidemiological model for pneumococcal carriage and disease is based on the assumption that vaccination completely eliminates vaccine-type carriage in the vaccinated population and that vaccine-type carriage is completely replaced by non-vaccine-type carriage. The implications of this replacement on the decrease or increase in pneumococcal disease then depend on the disease causing potential of the replacing types compared to that of the replaced types. To predict the incidence of post-vaccination disease only pre-vaccination data on serotype-specific carriage and disease are used.<br />
<br />
The consequences of serotype replacement in the model depend on two key assumptions regarding the new steady-state after vaccination:<br />
# the relative serotype proportions among the non-vaccine types are not affected by vaccination (proportionality assumption);<br />
# the case-to-carrier ratios (the disease causing potentials) of individual serotypes remain at their pre-vaccination levels.<br />
<br />
The implications of vaccination on disease incidence are assumed to be solely due to the elimination of vaccine type carriage and its replacement by non vaccine-type carriage. An exception to this is when protective efficacy against disease without any efficacy against carriage is assumed for certain serotypes (a feature to be added).<br />
<br />
<br />
<br><br />
<br><br />
<br />
[[File:Model_kuva_simplified2.jpg|thumb|center|600px|'''Figure 1. Illustration of the replacement model.''' The incidence of pneumococcal carriage (x-axis) and case-to-carrier ratios (y-axis) for vaccine serotypes (VT) and non-vaccine serotypes (NVT) before (panel A) and after vaccination (panel B). The incidences of disease (DVT and DNVT) are obtained by multiplication of the two quantities and correspond to the areas of the rectangles. After vaccination, VT carriage is eliminated and replaced by NVT carriage (panel B). The decrease in IPD incidence after vaccination is obtained as the difference between the eliminated VT disease and the replacing NVT disease. This is the area of the blue rectangle in panel B.]]<br />
<br />
<br />
<br><br />
'''Related research'''<br><br />
The replacement model was built to reflect the accumulated 15 year long experience on use of pneumococcal conjugate vaccines worldwide and the related scientific research activity. Some of the most recent relevant publications are listed on a separate page: [[References]].<br />
<br />
'''Sensitivity analysis'''<br><br />
To assess the sensitivity of the predictions produced by the epidemiological model, <br />
effects of some alternative scenarios regarding the role of certain serotypes in PCV10 and PCV13 were calculated. <br />
In particular, these scenarios concern assumptions about indirect protection against serotype 3 under PCV13, <br />
indirect protection against serotype 6A under PCV10, and direct protection against 19A in PCV10. The detailed results are <br />
reported on a separate page: [[Sensitivity_analysis_pcv_model]]. In summary, the most influential assumptions are whether or not there will be population-level (indirect) impact on serotype 3 disease under PCV13 and serotype 6A disease under PCV10. <br />
<br />
<br><br />
<br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Epidemiological_modelling&diff=33391Epidemiological modelling2014-08-27T10:19:43Z<p>Mnud: computation now in "answer" section</p>
<hr />
<div>[[op_fi:Epidemiologinen_malli]]<br />
{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
==Question==<br />
<br />
How to predict the net effectiveness of pneumococcal conjugate vaccination with a given set of serotypes when the vaccine is included in the national immunisation programme?<br />
<br />
* The focus is on the incidence of invasive pneumococcal disease (IPD) cases in different age groups covering the whole population.<br />
* The model is assumed to be valid in a population in which pneumococcal conjugate vaccination of infants has been in place for several years so that a new steady-state after vaccination has been reached. <br />
* The coverage of vaccination and vaccine efficacy against carriage are assumed to be high enough to justify the assumption of complete elimination of vaccine-type carriage among both the vaccinated and also, due to substantial herd effects, among the unvaccinated members of the population. <br />
* Vaccine-type carriage will be completely replaced by carriage of the non-vaccine types whose disease causing potential is not altered by vaccination.<br />
<br />
==Answer==<br />
<br />
The predicted reduction in the incidence of invasive pneumococcal disease (IPD) in different age groups are obtained from the serotype replacement model <ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref>. <br />
<br />
=== Computation ===<br />
<br />
The following program illustrates the working of the replacement model. In its current implementation the code allows the user to specify upto 4 vaccine compositions and then displays the predicted ''number'' of IPD cases in Finland per year corresponding to these vaccines. The results are shown by serotype and by age category (<5 and 5+ year olds). Possible choices for vaccine compositions are: PCV10, PCV13, no vaccination and a user specified serotype composition. The program is based on the code in File S1 in <ref name="optimalserotype"></ref>.<br />
<br />
<br><br />
<br />
<br />
'''Instructions for user: Choose the desired vaccine compositions from the list below and then press "Run code".'''<br />
<br />
You can compare 2,3 or 4 vaccine compositions. The results will be displayed on a separate tab. The default choice is PCV10 and PCV13.<br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13;<br />
'No_vaccination';No vaccination|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:custom_vac|description:Do you want to specify another vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
<br />
name:vac_user|description:Choose the serotypes for the user defined vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE"<br />
><br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
#vacc1 <- vac<br />
#vacc2 <- custom_vac<br />
<br />
if(custom_vac) {<br />
vac <- c(vac, "UserDefined")<br />
}<br />
<br />
if (length(vac) == 0) stop("No vaccines were specified.")<br />
<br />
user_args <- list(<br />
Scenario = vac<br />
)<br />
<br />
# Ulkoinen säilö datalle jollain sivulla?<br />
temp <- data.frame(<br />
Vaccine = rep(c("PCV10", "PCV13"), c(9, 12)), <br />
Serotype = c('19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7', <br />
'19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7', '3', '6A', '19A'<br />
)<br />
)<br />
<br />
user_args$Vaccines <- temp[temp$Vaccine %in% user_args$Scenario, ]<br />
<br />
if(custom_vac) {<br />
user_args$Vaccines <- rbind(<br />
user_args$Vaccines, <br />
data.frame(Vaccine = "UserDefined", Serotype = vac_user)<br />
)<br />
}<br />
<br />
#if(!exists("servac_user")) servac_user <- c('19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7')<br />
<br />
<br />
<br />
objects.latest("Op_fi4305", code_name = "alusta") # [[Pneumokokkirokote]]<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
openv.setN(100)<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
serotypes<-c(<br />
"19F", "23F", "6B", "14", "9V", "4", "18C", "1", "7",<br />
"6A", "19A", "3", "8", "9N", "10", "11", "12", "15",<br />
"16", "20", "22", "23A", "33", "35", "38", "6C", "Oth")<br />
car_under5<-c(<br />
156030, 156030, 126990, 41200, 22290, 12830, 10130, 10, 14180,<br />
54940, 24320, 12160, 1350, 20940, 4050, 72270, 10, 33100,<br />
3380, 1350, 12160, 3380, 680, 30400, 4050, 27470, 24320 )<br />
car_over5<-c(<br />
168100, 314800, 256700, 209800, 114100, 62500, 200700, 100, 100,<br />
158800, 54900, 30800, 8800, 8800, 20800, 97700, 100, 100,<br />
191900, 25200, 72500, 22000, 100, 71300, 100, 79400, 330100 )<br />
ipd_under5<-c(<br />
7.78, 7.88, 24.39, 20.76, 2.91, 2.91, 6.64, 0.31, 3.02,<br />
3.94, 9.88, 1.25, 0.10, 0.83, 0.41, 0.42, 0.21, 1.98,<br />
0.21, 0.01, 0.93, 0.10, 0.42, 0.31, 0.42, 0.01, 0.73 )<br />
ipd_over5<-c(<br />
28.51, 53.72, 29.53, 99.43, 43.07, 76.99, 24.39, 6.58, 46.88,<br />
17.42, 20.54, 55.04, 11.21, 25.20, 6.28, 12.76, 13.89, 9.18,<br />
4.73, 3.29, 29.03, 4.40, 5.64, 12.41, 1.43, 5.50, 11.20 )<br />
<br />
## Combine the data into 2 matrices of dimension 27*2:<br />
IPD<-cbind(ipd_under5, ipd_over5)<br />
Car<-cbind(car_under5, car_over5)<br />
<br />
## Row numbers corresponding to the 3 different PCV formulations<br />
## in matrices IPD and Car. Note: there is no serotype 5 in our data.<br />
pcv7rows<-seq(7); pcv10rows<-seq(9); pcv13rows<-seq(12)<br />
<br />
<br />
## Example S1.2A: Calculate the predicted incidence of IPD for the non-vaccine<br />
## types(NVTs) under PCV13. The predictions are calculated separately for the<br />
## two age classes. These are the values reported on the bottom panel in<br />
## Figure 2 (there given as per 100K incidences).<br />
postvacc <-Vaccination(IPD,Car,VT_rows=pcv13rows,p=1,q=1)<br />
<br />
<br />
## Example S1.2B: Decrease in IPD incidence after adding a single new serotype<br />
## to PCV13 separately for the two age categories.<br />
next_under5<-NextVT(IPD[,1],Car[,1], VT_rows=pcv13rows,p=1)<br />
next_over5 <-NextVT(IPD[,2],Car[,2], VT_rows=pcv13rows,p=1)<br />
<br />
# Nämä taulukot kannattaisi transposata niin näyttäisivät siistimmiltä.<br />
<br />
## Example S1.3A: The optimal sequence for under 5 year olds when replacement is 100%.<br />
## The output shows the decreases in IPD incidence for each step,<br />
## corresponding to Figure 5(C). The last serotype (row 27, the category "Other")<br />
## is excluded from any vaccine composition but is taken into account as a<br />
## replacing serotype at each stage.<br />
opt<-OptimalSequence(IPD[,1],Car[,1],VT_rows=0,Excluded_rows=27,p=1.0,HowmanyAdded=20)<br />
<br />
<br />
## Example S1.3B: The optimal sequence for the whole population when<br />
## replacement is 50% and the current composition includes the PCV7 serotypes.<br />
opt<-OptimalSequence(IPD,Car, VT_rows=pcv7rows,Excluded_rows=length(serotypes),<br />
p=0.5,HowmanyAdded=17)<br />
<br />
<br />
###################################<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
servac <- merge(data.frame(Vaccine = user_args$Scenario), data.frame(Serotype = serotypes))<br />
servac <- merge(<br />
data.frame(user_args$Vaccines, Result = 1), <br />
servac, <br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
#data.frame(<br />
#Vaccine = rep(c("Current", "New"), each = length(serotypes)),<br />
#Serotype = serotypes,<br />
#Result = as.numeric(c(<br />
# serotypes %in% c("19F", "23F", "6B", "14", "9V", "4", "18C", "1", "7"),<br />
# serotypes %in% servac_user<br />
# ))<br />
#))<br />
<br />
p_user<-q_user<-adultcarriers<-1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
# The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) }<br />
<br />
<br />
<br />
<br />
if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Incidence of invasive pneumococcal disease", y = "Number of cases per year")<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Age)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Incidence of invasive pneumococcal disease", y = "Number of cases per year")<br />
<br />
</rcode><br />
<br />
<br />
=== Data ===<br />
<br />
{{hidden|<br />
<br />
<t2b name='Pneumococcal carriage and IPD _' index='Serotype,Age,Observation' locations='Carriage,IPD' unit='Number of cases per year'><br />
19F|Under 5|156030|7.78<br />
23F|Under 5|156030|7.88<br />
6B|Under 5|126990|24.39<br />
14|Under 5|41200|20.76<br />
9V|Under 5|22290|2.91<br />
4|Under 5|12830|2.91<br />
18C|Under 5|10130|6.64<br />
1|Under 5|10|0.31<br />
7|Under 5|14180|3.02<br />
6A|Under 5|54940|3.94<br />
19A|Under 5|24320|9.88<br />
3|Under 5|12160|1.25<br />
8|Under 5|1350|0.1<br />
9N|Under 5|20940|0.83<br />
10|Under 5|4050|0.41<br />
11|Under 5|72270|0.42<br />
12|Under 5|10|0.21<br />
15|Under 5|33100|1.98<br />
16|Under 5|3380|0.21<br />
20|Under 5|1350|0.01<br />
22|Under 5|12160|0.93<br />
23A|Under 5|3380|0.1<br />
33|Under 5|680|0.42<br />
35|Under 5|30400|0.31<br />
38|Under 5|4050|0.42<br />
6C|Under 5|27470|0.01<br />
Oth|Under 5|24320|0.73<br />
19F|Over 5|168100|28.51<br />
23F|Over 5|314800|53.72<br />
6B|Over 5|256700|29.53<br />
14|Over 5|209800|99.43<br />
9V|Over 5|114100|43.07<br />
4|Over 5|62500|76.99<br />
18C|Over 5|200700|24.39<br />
1|Over 5|100|6.58<br />
7|Over 5|100|46.88<br />
6A|Over 5|158800|17.42<br />
19A|Over 5|54900|20.54<br />
3|Over 5|30800|55.04<br />
8|Over 5|8800|11.21<br />
9N|Over 5|8800|25.2<br />
10|Over 5|20800|6.28<br />
11|Over 5|97700|12.76<br />
12|Over 5|100|13.89<br />
15|Over 5|100|9.18<br />
16|Over 5|191900|4.73<br />
20|Over 5|25200|3.29<br />
22|Over 5|72500|29.03<br />
23A|Over 5|22000|4.4<br />
33|Over 5|100|5.64<br />
35|Over 5|71300|12.41<br />
38|Over 5|100|1.43<br />
6C|Over 5|79400|5.5<br />
Oth|Over 5|330100|11.2<br />
</t2b><br />
<br />
<t2b name="Serotypes in typical pneumococcal vaccines" index="Vaccine" obs="Serotype" unit="-"><br />
PCV10|19F<br />
PCV10|23F<br />
PCV10|6B<br />
PCV10|14<br />
PCV10|9V<br />
PCV10|4<br />
PCV10|18C<br />
PCV10|1<br />
PCV10|7<br />
PCV13|19F<br />
PCV13|23F<br />
PCV13|6B<br />
PCV13|14<br />
PCV13|9V<br />
PCV13|4<br />
PCV13|18C<br />
PCV13|1<br />
PCV13|7<br />
PCV13|3<br />
PCV13|6A<br />
PCV13|19A<br />
Existing serotypes|19F<br />
Existing serotypes|23F<br />
Existing serotypes|6B<br />
Existing serotypes|14<br />
Existing serotypes|9V<br />
Existing serotypes|4<br />
Existing serotypes|18C<br />
Existing serotypes|1<br />
Existing serotypes|7<br />
Existing serotypes|6A<br />
Existing serotypes|19A<br />
Existing serotypes|3<br />
Existing serotypes|8<br />
Existing serotypes|9N<br />
Existing serotypes|10<br />
Existing serotypes|11<br />
Existing serotypes|12<br />
Existing serotypes|15<br />
Existing serotypes|16<br />
Existing serotypes|20<br />
Existing serotypes|22<br />
Existing serotypes|23A<br />
Existing serotypes|33<br />
Existing serotypes|35<br />
Existing serotypes|38<br />
Existing serotypes|6C<br />
Existing serotypes|Oth<br />
</t2b><br />
}}<br />
<br />
=== Initiate functions (only for developers) ===<br />
<br />
<rcode name="initiate" label="Initiate functions" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
#S1.4. The R-functions<br />
###############################################################################<br />
##<br />
## R code for the core methods introduced in<br />
## Markku Nurhonen and Kari Auranen:<br />
## "Optimal serotype compositions for pneumococcal conjugate<br />
## vaccination under serotype replacement",<br />
## PLoS Computational Biology, 2014.<br />
##<br />
###############################################################################<br />
## List of arguments common to most functions:<br />
##<br />
## IPD = matrix of IPD incidences by age class (columns) and serotype (rows)<br />
## Car = corresponding matrix of carriage incidences<br />
## VT_rows = vector of the row numbers in matrices IPD and Car<br />
## corresponding to vaccine types (VT_rows=0 for no vaccination)<br />
## p = proportion of lost VT carriage which is replaced by NVT carriage<br />
## q = proportion of VT carriage lost either due to elimination or replacement<br />
##<br />
## This code includes 4 functions:<br />
## Vaccination, NextVT, OptimalSequence and OptimalVacc.<br />
##<br />
<br />
Vaccination<-function(IPD,Car,VT_rows,p,q) {<br />
##<br />
## Result:<br />
## A list of 2 matrices: IPD and carriage incidences<br />
## after vaccination (corresponding to matrices IPD and Car).<br />
## [Markku Nurhonen 2013]<br />
##<br />
if (VT_rows[1]>0) {<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
# Post vaccination carriage incidences<br />
Car_Total<-t(matrix(apply(Car,2,sum),dim(Car)[2],dim(Car)[1]))<br />
Car2<-Car; Car2[VT_rows,]<-0<br />
Car_NVT<-t(matrix(apply(Car2,2,sum),dim(Car2)[2],dim(Car2)[1]))<br />
Car_VT<-Car_Total-Car_NVT<br />
CarNew<-q*(1+p*Car_VT/Car_NVT)*Car2+(1-q)*Car<br />
# Post vaccination IPD incidences<br />
NVT_rows<-seq(dim(IPD)[1])[-1*VT_rows]<br />
# CCR=Case-to-carrier ratios<br />
CCR<-IPD/Car ; IPDNew<-0*IPD<br />
# Apply the equation appearing above<br />
# equation (1) in text for each serotype.<br />
# First term applies to NVTs.<br />
IPDNew[VT_rows,]<-(1-q)*IPD[VT_rows,]<br />
# Second term applies to NVTs.<br />
IPDNew[NVT_rows,]<-((Car_NVT+p*q*Car_VT)*(Car/Car_NVT)*CCR)[NVT_rows,]<br />
}<br />
else {<br />
IPDNew<-IPD; CarNew<-Car<br />
}<br />
list(IPDNew,CarNew) <br />
}<br />
<br />
NextVT<-function(IPD,Car,VT_rows,p) {<br />
##<br />
## Result:<br />
## A vector of decreases in IPD due to adding a serotype<br />
## to the vaccine. If VT_rows=0, initially no vaccination.<br />
## For row indexes incuded in VT_rows, the result is 0.<br />
## [Markku Nurhonen 2013]<br />
##<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
<br />
## VaccMat = IPD and Car matrices after vaccination<br />
VaccMat<-Vaccination(IPD,Car,VT_rows,p,1)<br />
IPD<-VaccMat[[1]]; Car<-VaccMat[[2]]<br />
<br />
## Total_IPD,Total_Car = Matrices corresponding to<br />
## overall IPD and carriage in each age class.<br />
Total_IPD<-t(matrix(apply(IPD,2,sum),dim(IPD)[2],dim(IPD)[1]))<br />
Total_Car<-t(matrix(apply(Car,2,sum),dim(Car)[2],dim(Car)[1]))<br />
<br />
## Effect = decrease in IPD when one serotype is added to the vaccine.<br />
## See equation (3) in text.<br />
Effect<-(Total_IPD-IPD)*((IPD/(Total_IPD-IPD))-(p*Car/(Total_Car-Car)))<br />
<br />
## Special case when only one NVT remains.<br />
IPD_nonzero<-which(apply(IPD,1,sum)!=0)<br />
if (length(IPD_nonzero)==1) {Effect[IPD_nonzero,]<-IPD[IPD_nonzero,]}<br />
<br />
## Result is obtained after summation over age classes.<br />
apply(Effect,1,sum) <br />
}<br />
<br />
OptimalSequence<-function(IPD,Car,VT_rows,Excluded_rows,p,HowmanyAdded) {<br />
##<br />
## Starting from VTs indicated by the vector VT_rows<br />
## (VT_rows=0, for no vaccination) sequentially add new VTs<br />
## to the vaccine composition s.t. at each step the optimal<br />
## serotype (corresponding to largest decrease in IPD) is added.<br />
##<br />
## Excluded_rows = Vector of indexes of the rows in matrices<br />
## IPD and Car corresponding to serotypes that are not to<br />
## be included in a vaccine composition, e.g. a row<br />
## corresponding to a group of serotypes labelled "Other".<br />
## Enter Excluded_rows=0 for no excluded serotypes.<br />
## HowmanyAdded = number of VTs to be added.<br />
##<br />
## Result:<br />
## Matrix of dimension 2*HowmanyAdded with 1st row indicating<br />
## the row numbers of added serotypes in the order they appear<br />
## in the sequence. The 2nd row lists the decreases in IPD<br />
## due to addition of each type. [Markku Nurhonen 2013]<br />
##<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
## First check the maximum possible number of added VTs.<br />
VT_howmany<-length(VT_rows)<br />
if (VT_rows[1]==0) {VT_howmany<-0}<br />
Excluded_howmany<-length(Excluded_rows)<br />
if (Excluded_rows[1]==0) {Excluded_howmany<-0}<br />
HowmanyAdded<-min(HowmanyAdded,dim(IPD)[1]-(VT_howmany+Excluded_howmany))<br />
BestVTs<-BestEffects<-rep(0,HowmanyAdded)<br />
## Sequential procedure: at each step find the best additional VT.<br />
for (i in 1:HowmanyAdded) {<br />
## Effects = Decrease in IPD after addition of each serotype<br />
Effects<-NextVT(IPD,Car,VT_rows,p)<br />
## Set Effects for VTs and excluded types equal to small values<br />
## so that none of these will be selected as the next VT.<br />
minvalue<- -2*max(abs(Effects))<br />
if (Excluded_howmany>0) {Effects[Excluded_rows]<-minvalue}<br />
if (VT_rows[1]>0) {Effects[VT_rows]<-minvalue}<br />
## BestVTs[i] = Index of serotype with maximum decrease in IPD.<br />
BestVTs[i]<-order(-1*Effects)[1]<br />
## BestEffects[i] = Decrese in IPD due to addition of BestVTs[i]<br />
## to the vaccine.<br />
BestEffects[i]<-Effects[BestVTs[i]]<br />
VT_rows<-c(VT_rows,BestVTs[i])<br />
if (VT_rows[1]==0) {VT_rows<-VT_rows[-1]}<br />
VaccMat<-Vaccination(IPD,Car,VT_rows,p,1)<br />
IPD<-VaccMat[[1]]; Car<-VaccMat[[2]] <br />
}<br />
t(matrix(c(BestVTs,BestEffects),HowmanyAdded,2)) <br />
}<br />
<br />
OptimalVacc<-function(IPD,Car,VT_rows,p,q,HowmanyAdded) {<br />
##<br />
## Result:<br />
## A list of 3 elements: (1) Row numbers of serotypes in the optimal<br />
## vaccine composition (2)-(3) IPD and carriage incidences<br />
## by serotype and age class corresponding to the optimal<br />
## vaccine formed using the sequential procedure in the<br />
## function OptimalSequence. [Markku Nurhonen 2013]<br />
##<br />
Additional_VTs<-OptimalSequence(IPD,Car,VT_rows,p,HowmanyAdded)[1,]<br />
All_VTs<-c(VT_rows,Additional_VTs)<br />
if (All_VTs[1]==0) All_VTs<-All_VTs[-1]<br />
VaccMat<-Vaccination(IPD,Car,All_VTs,p,q)<br />
list(All_VTs,VaccMat[[1]],VaccMat[[2]]) <br />
}<br />
<br />
VacCar <- Ovariable("VacCar",<br />
dependencies = data.frame(Name = c(<br />
"IPD", # incidence of pneumococcus disease<br />
"Car", # number of carriers of pneumococcus<br />
"servac", # ovariable of serotypes in vaccine (1 for serotypes in a vaccine, otherwise result is 0)<br />
"p", # proportion of eliminated VT carriage that is replaced by NVT carriage<br />
"q" # proportion of of VT carriage eliminated by vaccine<br />
)), <br />
formula = function(...) {<br />
## Result:<br />
## An ovariable of carriage incidences<br />
## after vaccination (corresponding to Car).<br />
## [Markku Nurhonen 2013, Jouni Tuomisto 2014]<br />
# Post vaccination carriage incidences<br />
<br />
# Sum over serotypes and drop extra columns<br />
#Car_Total<- unkeep(oapply(Car, cols = "Serotype", FUN = sum) * 1, prevresults = TRUE)<br />
# Car2 is a temporary ovariable with NVT carriers only<br />
#Car2 <- unkeep(Car * (1 - servac), prevresults = TRUE) # Take only NVT carriers<br />
<br />
#Car_NVT <- oapply(Car2, cols = "Serotype", FUN = sum) # Carriers of serotypes not in vaccine (NVT)<br />
#Car_VT <- Car_Total - Car_NVT # Carriers of vaccine serotypes<br />
<br />
#CarNew <- q * (1 + p * Car_VT / Car_NVT) * Car2 + (1 - q) * Car<br />
<br />
eliminated <- q * servac * Car<br />
eliminated <- unkeep(eliminated, prevresults = TRUE)<br />
<br />
replaced <- oapply(eliminated, NULL, sum, "Serotype") * p<br />
# Distribute increase evenly among non-vaccine serotypes<br />
replaced <- unkeep(1 - servac, prevresults = TRUE) / <br />
oapply(unkeep(1 - servac, prevresults = TRUE), NULL, sum, "Serotype") * <br />
replaced<br />
<br />
replaced <- unkeep(replaced, prevresults = TRUE)<br />
<br />
CarNew <- Car - eliminated + replaced<br />
return(CarNew)<br />
}<br />
)<br />
<br />
VacIPD <- Ovariable("VacIPD",<br />
dependencies = data.frame(Name = c(<br />
"IPD", # incidence of pneumococcus disease<br />
"Car", # number of carriers of pneumococcus<br />
"servac", # ovariable of serotypes in vaccine (1 for serotypes in a vaccine, otherwise result is 0)<br />
"p", # proportion of eliminated VT carriage that is replaced by NVT carriage<br />
"q" # proportion of of VT carriage eliminated by vaccine<br />
#"VacCar" # proportional serotype carriage after vaccination<br />
)), <br />
formula = function(...) {<br />
## Result:<br />
## An ovariable of IPD incidence<br />
## after vaccination (corresponding to ovariable IPD).<br />
## [Markku Nurhonen 2013, Jouni Tuomisto 2014]<br />
<br />
# Post vaccination carriage incidences (same code as in VacCar)<br />
<br />
#Car_Total <- unkeep(oapply(Car, cols = "Serotype", FUN = sum) * 1, prevresults = TRUE) # Sums over serotypes<br />
#Car2 <- unkeep(Car * (1 - servac), prevresults = TRUE)<br />
<br />
#Car_NVT <- oapply(Car2, cols = "Serotype", FUN = sum) # Carriers of serotypes not in vaccine (NVT)<br />
#Car_VT <- Car_Total - Car_NVT # Carriers of vaccine serotypes<br />
#CarNew <- q * (1 + p * Car_VT / Car_NVT) * Car2 + (1 - q) * Car<br />
<br />
# Post vaccination IPD incidences<br />
# CCR=Case-to-carrier ratios<br />
#CCR <- IPD / Car<br />
<br />
# Apply the equation appearing above<br />
# equation (1) in text for each serotype.<br />
# First term applies to VTs.<br />
#IPDNewVT <- (1 - q) * IPD * servac<br />
<br />
# Second term applies to NVTs.<br />
#IPDNewNVT <- (Car_NVT + p * q * Car_VT) * (Car / Car_NVT) * CCR * (1 - servac)<br />
<br />
#IPDNew <- IPDNewVT + IPDNewNVT<br />
<br />
#IPDNew <- IPD * unkeep(VacCar, prevresults = TRUE) / Car<br />
#IPDNew <- IPD * exp(unkeep(log(VacCar), prevresults = TRUE) - unkeep(log(Car), prevresults = TRUE))<br />
<br />
eliminated <- q * servac * Car<br />
eliminated <- unkeep(eliminated, prevresults = TRUE)<br />
<br />
replaced <- oapply(eliminated, NULL, sum, "Serotype") * p<br />
# Distribute increase evenly among non-vaccine serotypes<br />
#replaced <- unkeep(1 - servac, prevresults = TRUE) / <br />
# oapply(1 - servac, NULL, sum, "Serotype") * <br />
# replaced<br />
<br />
replaced <- unkeep(replaced, prevresults = TRUE)<br />
<br />
IPDNew <- ((1 - q * servac) + (1 - servac) * replaced / oapply((1 - servac) * Car, NULL, sum, "Serotype")) * IPD <br />
#oapply(IPDNew, IPDNew@output$Vaccine, sum)<br />
<br />
return(IPDNew) <br />
}<br />
)<br />
<br />
objects.store(Vaccination, NextVT, OptimalSequence, OptimalVacc, VacCar, VacIPD)<br />
<br />
cat("the functions Vaccination, NextVT, OptimalSequence, OptimalVacc and the ovariables VacCar, VacIPD are now saved. \n")<br />
<br />
</rcode><br />
<br />
<br />
==Rationale==<br />
<br />
The epidemiological model for pneumococcal carriage and disease is based on the assumption that vaccination completely eliminates vaccine-type carriage in the vaccinated population and that vaccine-type carriage is completely replaced by non-vaccine-type carriage. The implications of this replacement on the decrease or increase in pneumococcal disease then depend on the disease causing potential of the replacing types compared to that of the replaced types. To predict the incidence of post-vaccination disease only pre-vaccination data on serotype-specific carriage and disease are used.<br />
<br />
The consequences of serotype replacement in the model depend on two key assumptions regarding the new steady-state after vaccination:<br />
# the relative serotype proportions among the non-vaccine types are not affected by vaccination (proportionality assumption);<br />
# the case-to-carrier ratios (the disease causing potentials) of individual serotypes remain at their pre-vaccination levels.<br />
<br />
The implications of vaccination on disease incidence are assumed to be solely due to the elimination of vaccine type carriage and its replacement by non vaccine-type carriage. An exception to this is when protective efficacy against disease without any efficacy against carriage is assumed for certain serotypes (a feature to be added).<br />
<br />
<br />
<br><br />
<br><br />
<br />
[[File:Model_kuva_simplified2.jpg|thumb|center|600px|'''Figure 1. Illustration of the replacement model.''' The incidence of pneumococcal carriage (x-axis) and case-to-carrier ratios (y-axis) for vaccine serotypes (VT) and non-vaccine serotypes (NVT) before (panel A) and after vaccination (panel B). The incidences of disease (DVT and DNVT) are obtained by multiplication of the two quantities and correspond to the areas of the rectangles. After vaccination, VT carriage is eliminated and replaced by NVT carriage (panel B). The decrease in IPD incidence after vaccination is obtained as the difference between the eliminated VT disease and the replacing NVT disease. This is the area of the blue rectangle in panel B.]]<br />
<br />
<br />
<br><br />
'''Related research'''<br><br />
The replacement model was built to reflect the accumulated 15 year long experience on use of pneumococcal conjugate vaccines worldwide and the related scientific research activity. Some of the most recent relevant publications are listed on a separate page: [[References]].<br />
<br />
'''Sensitivity analysis'''<br><br />
To assess the sensitivity of the predictions produced by the epidemiological model, <br />
effects of some alternative scenarios regarding the role of certain serotypes in PCV10 and PCV13 were calculated. <br />
In particular, these scenarios concern assumptions about indirect protection against serotype 3 under PCV13, <br />
indirect protection against serotype 6A under PCV10, and direct protection against 19A in PCV10. The detailed results are <br />
reported on a separate page: [[Sensitivity_analysis_pcv_model]]. In summary, the most influential assumptions are whether or not there will be population-level (indirect) impact on serotype 3 disease under PCV13 and serotype 6A disease under PCV10. <br />
<br />
<br><br />
<br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33325Economic evaluation2014-08-25T14:13:42Z<p>Mnud: incl. sequlae lisätty</p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
=== Computation ===<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. <br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:debug_plot|description:Debug plots|type:checkbox|options:1;Show all|default:|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
costsum <- Total_costs<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
if (!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
if (!is.null(debug_plot)) plot3<br />
if (!is.null(debug_plot)) plot2<br />
if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty, for debugging purposes<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
ipdtable <- oapply(VacIPD, VacIPD@output["Vaccine"], sum)@output<br />
colnames(ipdtable)[colnames(ipdtable) == "VacIPDResult"] <- "N_of_IPD_cases"<br />
<br />
oprint(<br />
ipdtable[order(match(ipdtable$Vaccine, qorder)),],<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top",<br />
digits = rep(0, ncol(ipdtable) + 1)<br />
) <br />
<br />
##############################<br />
## print health care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine = qorder,<br />
Medical_costs = result(health_care_costs)[match(qorder,health_care_costs@output$Vaccine)] * 1e-6,<br />
Vaccine_programme_cost = result(vacprice) * 1e-6,<br />
Health_care_costs = result(costsum)[match(qorder,costsum@output$Vaccine)] * 1e-6<br />
)<br />
oprint(<br />
sum_table1A,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top",<br />
digits = c(0,0,2,2,2)<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(<br />
tekstia, <br />
include.rownames = FALSE, <br />
include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top"<br />
)<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained = QALYs_gained,<br />
Incremental_effect = QALYs_incremental,<br />
Health_care_costs = Cost_total * 1e-6,<br />
Incremental_cost = Cost_incremental * 1e-6,<br />
ICER = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top",<br />
digits = c(0,0,0,0,2,2,2)<br />
)<br />
</rcode><br />
<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Rationale == <br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER):<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
<br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Sensitivity ===<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
=== Data ===<br />
Summary table of the data applied in the cost-effectiveness analysis. Note, that the cost-effectiveness analysis is based on age-year (0-100) specific data on IPD and life years lost.<br />
<br />
1. QALY_menin = QALY losses due to meningitis incl. sequlae (in years, *)<br />
2. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
3. CFR = Case fatality ratio for meningitis and bacteremia<br />
4. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
5. Cost_ menin = Medical costs attributed to meningitis incl. sequlae (in euros *)<br />
6. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
7. Menin_proportion = Proportion of meningitis cases of all IPD cases<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
{| || {{prettytable}}<br />
|+Estimated medical costs and years lost due to a single bacteremia or meningitis episode <br />
| Age class || QALY_men || QALY_bac || CFR || Life_y_lost || COST_men || COST_bac || Menin_proportion<br />
|---<br />
| <5 years || 0.22 || 0.0079 || 0.014 || 31.1 || 22 070 || 1 986 || 0.037<br />
|---<br />
| 5-64 years || 0.16 || 0.0079 || 0.112 || 20.7 || 26 488 || 9 000 || 0.046<br />
|---<br />
| 65+ years || 0.08 || 0.0079 || 0.196 || 9.4 || 21 529 || 6 823 || 0.019<br />
|---<br />
|}<br />
* Note: The above table lists averages within each age class. Cost-effectiveness analysis is based on age year -specific values.<br />
<br />
<br><br />
<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost in Finland without vaccination (per year)<br />
|---<br />
|Age group||QALY_meningitis||QALY_bacteremia||Life_years_lost||Cost_meningitis||Cost_bacteremia<br />
|---<br />
|0-4y||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|5-64y||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|65+y||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
<br />
<br><br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33316Economic evaluation2014-08-25T11:52:16Z<p>Mnud: </p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
=== Computation ===<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. <br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:debug_plot|description:Debug plots|type:checkbox|options:1;Show all|default:|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
costsum <- Total_costs<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
if (!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
if (!is.null(debug_plot)) plot3<br />
if (!is.null(debug_plot)) plot2<br />
if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty, for debugging purposes<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
ipdtable <- oapply(VacIPD, VacIPD@output["Vaccine"], sum)@output<br />
colnames(ipdtable)[colnames(ipdtable) == "VacIPDResult"] <- "N_of_IPD_cases"<br />
<br />
oprint(<br />
ipdtable[order(match(ipdtable$Vaccine, qorder)),],<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top",<br />
digits = rep(0, ncol(ipdtable) + 1)<br />
) <br />
<br />
##############################<br />
## print health care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine = qorder,<br />
Medical_costs = result(health_care_costs)[match(qorder,health_care_costs@output$Vaccine)] * 1e-6,<br />
Vaccine_programme_cost = result(vacprice) * 1e-6,<br />
Health_care_costs = result(costsum)[match(qorder,costsum@output$Vaccine)] * 1e-6<br />
)<br />
oprint(<br />
sum_table1A,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top",<br />
digits = c(0,0,2,2,2)<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(<br />
tekstia, <br />
include.rownames = FALSE, <br />
include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top"<br />
)<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained = QALYs_gained,<br />
Incremental_effect = QALYs_incremental,<br />
Health_care_costs = Cost_total * 1e-6,<br />
Incremental_cost = Cost_incremental * 1e-6,<br />
ICER = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
sortable = FALSE,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top",<br />
digits = c(0,0,0,0,2,2,2)<br />
)<br />
</rcode><br />
<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Rationale == <br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER):<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
<br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Sensitivity ===<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
=== Data ===<br />
Summary table of the data applied in the cost-effectiveness analysis. Note, that the cost-effectiveness analysis is based on age-year (0-100) specific data on IPD and life years lost.<br />
<br />
1. QALY_menin = QALY losses due to meningitis (in years, *)<br />
2. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
3. CFR = Case fatality ratio for meningitis and bacteremia<br />
4. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
5. Cost_ menin = Medical costs attributed to meningitis (in euros *)<br />
6. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
7. Menin_proportion = Proportion of meningitis cases of all IPD cases<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
{| || {{prettytable}}<br />
|+Estimated medical costs and years lost due to a single bacteremia or meningitis episode <br />
| Age class || QALY_men || QALY_bac || CFR || Life_y_lost || COST_men || COST_bac || Menin_proportion<br />
|---<br />
| <5 years || 0.22 || 0.0079 || 0.014 || 31.1 || 22 070 || 1 986 || 0.037<br />
|---<br />
| 5-64 years || 0.16 || 0.0079 || 0.112 || 20.7 || 26 488 || 9 000 || 0.046<br />
|---<br />
| 65+ years || 0.08 || 0.0079 || 0.196 || 9.4 || 21 529 || 6 823 || 0.019<br />
|---<br />
|}<br />
* Note: The above table lists averages within each age class. Cost-effectiveness analysis is based on age year -specific values.<br />
<br />
<br><br />
<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost in Finland without vaccination (per year)<br />
|---<br />
|Age group||QALY_meningitis||QALY_bacteremia||Life_years_lost||Cost_meningitis||Cost_bacteremia<br />
|---<br />
|0-4y||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|5-64y||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|65+y||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
<br />
<br><br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Epidemiological_modelling&diff=33313Epidemiological modelling2014-08-25T10:21:02Z<p>Mnud: </p>
<hr />
<div>[[op_fi:Epidemiologinen_malli]]<br />
{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
==Question==<br />
<br />
How to predict the net effectiveness of pneumococcal conjugate vaccination with a given set of serotypes when the vaccine is included in the national immunisation programme?<br />
<br />
* The focus is on the incidence of invasive pneumococcal disease (IPD) cases in different age groups covering the whole population.<br />
* The model is assumed to be valid in a population in which pneumococcal conjugate vaccination of infants has been in place for several years so that a new steady-state after vaccination has been reached. <br />
* The coverage of vaccination and vaccine efficacy against carriage are assumed to be high enough to justify the assumption of complete elimination of vaccine-type carriage among both the vaccinated and also, due to substantial herd effects, among the unvaccinated members of the population. <br />
* Vaccine-type carriage will be completely replaced by carriage of the non-vaccine types whose disease causing potential is not altered by vaccination.<br />
<br />
==Answer==<br />
<br />
The predicted reduction in the incidence of invasive pneumococcal disease (IPD) in different age groups are obtained from the serotype replacement model <ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref>. <br />
<br />
==Rationale==<br />
<br />
The epidemiological model for pneumococcal carriage and disease is based on the assumption that vaccination completely eliminates vaccine-type carriage in the vaccinated population and that vaccine-type carriage is completely replaced by non-vaccine-type carriage. The implications of this replacement on the decrease or increase in pneumococcal disease then depend on the disease causing potential of the replacing types compared to that of the replaced types. To predict the incidence of post-vaccination disease only pre-vaccination data on serotype-specific carriage and disease are used.<br />
<br />
The consequences of serotype replacement in the model depend on two key assumptions regarding the new steady-state after vaccination:<br />
# the relative serotype proportions among the non-vaccine types are not affected by vaccination (proportionality assumption);<br />
# the case-to-carrier ratios (the disease causing potentials) of individual serotypes remain at their pre-vaccination levels.<br />
<br />
The implications of vaccination on disease incidence are assumed to be solely due to the elimination of vaccine type carriage and its replacement by non vaccine-type carriage. An exception to this is when protective efficacy against disease without any efficacy against carriage is assumed for certain serotypes (a feature to be added).<br />
<br />
<br />
<br><br />
<br><br />
<br />
[[File:Model_kuva_simplified2.jpg|thumb|center|600px|'''Figure 1. Illustration of the replacement model.''' The incidence of pneumococcal carriage (x-axis) and case-to-carrier ratios (y-axis) for vaccine serotypes (VT) and non-vaccine serotypes (NVT) before (panel A) and after vaccination (panel B). The incidences of disease (DVT and DNVT) are obtained by multiplication of the two quantities and correspond to the areas of the rectangles. After vaccination, VT carriage is eliminated and replaced by NVT carriage (panel B). The decrease in IPD incidence after vaccination is obtained as the difference between the eliminated VT disease and the replacing NVT disease. This is the area of the blue rectangle in panel B.]]<br />
<br />
<br />
<br><br />
'''Related research'''<br><br />
The replacement model was built to reflect the accumulated 15 year long experience on use of pneumococcal conjugate vaccines worldwide and the related scientific research activity. Some of the most recent relevant publications are listed on a separate page: [[References]].<br />
<br />
'''Sensitivity analysis'''<br><br />
To assess the sensitivity of the predictions produced by the epidemiological model, <br />
effects of some alternative scenarios regarding the role of certain serotypes in PCV10 and PCV13 were calculated. <br />
In particular, these scenarios concern assumptions about indirect protection against serotype 3 under PCV13, <br />
indirect protection against serotype 6A under PCV10, and direct protection against 19A in PCV10. The detailed results are <br />
reported on a separate page: [[Sensitivity_analysis_pcv_model]]. In summary, the most influential assumptions are whether or not there will be population-level (indirect) impact on serotype 3 disease under PCV13 and serotype 6A disease under PCV10. <br />
<br />
<br><br />
<br />
=== Computation ===<br />
<br />
The following program illustrates the working of the replacement model. In its current implementation the code allows the user to specify upto 4 vaccine compositions and then displays the predicted ''number'' of IPD cases in Finland per year corresponding to these vaccines. The results are shown by serotype and by age category (<5 and 5+ year olds). Possible choices for vaccine compositions are: PCV10, PCV13, no vaccination and a user specified serotype composition. The program is based on the code in File S1 in <ref name="optimalserotype"></ref>.<br />
<br />
<br><br />
<br />
<br />
'''Instructions for user: Choose the desired vaccine compositions from the list below and then press "Run code".'''<br />
<br />
You can compare 2,3 or 4 vaccine compositions. The results will be displayed on a separate tab. The default choice is PCV10 and PCV13.<br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13;<br />
'No_vaccination';No vaccination|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:custom_vac|description:Do you want to specify another vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
<br />
name:vac_user|description:Choose the serotypes for the user defined vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE"<br />
><br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
#vacc1 <- vac<br />
#vacc2 <- custom_vac<br />
<br />
if(custom_vac) {<br />
vac <- c(vac, "UserDefined")<br />
}<br />
<br />
if (length(vac) == 0) stop("No vaccines were specified.")<br />
<br />
user_args <- list(<br />
Scenario = vac<br />
)<br />
<br />
# Ulkoinen säilö datalle jollain sivulla?<br />
temp <- data.frame(<br />
Vaccine = rep(c("PCV10", "PCV13"), c(9, 12)), <br />
Serotype = c('19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7', <br />
'19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7', '3', '6A', '19A'<br />
)<br />
)<br />
<br />
user_args$Vaccines <- temp[temp$Vaccine %in% user_args$Scenario, ]<br />
<br />
if(custom_vac) {<br />
user_args$Vaccines <- rbind(<br />
user_args$Vaccines, <br />
data.frame(Vaccine = "UserDefined", Serotype = vac_user)<br />
)<br />
}<br />
<br />
#if(!exists("servac_user")) servac_user <- c('19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7')<br />
<br />
<br />
<br />
objects.latest("Op_fi4305", code_name = "alusta") # [[Pneumokokkirokote]]<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
openv.setN(100)<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
serotypes<-c(<br />
"19F", "23F", "6B", "14", "9V", "4", "18C", "1", "7",<br />
"6A", "19A", "3", "8", "9N", "10", "11", "12", "15",<br />
"16", "20", "22", "23A", "33", "35", "38", "6C", "Oth")<br />
car_under5<-c(<br />
156030, 156030, 126990, 41200, 22290, 12830, 10130, 10, 14180,<br />
54940, 24320, 12160, 1350, 20940, 4050, 72270, 10, 33100,<br />
3380, 1350, 12160, 3380, 680, 30400, 4050, 27470, 24320 )<br />
car_over5<-c(<br />
168100, 314800, 256700, 209800, 114100, 62500, 200700, 100, 100,<br />
158800, 54900, 30800, 8800, 8800, 20800, 97700, 100, 100,<br />
191900, 25200, 72500, 22000, 100, 71300, 100, 79400, 330100 )<br />
ipd_under5<-c(<br />
7.78, 7.88, 24.39, 20.76, 2.91, 2.91, 6.64, 0.31, 3.02,<br />
3.94, 9.88, 1.25, 0.10, 0.83, 0.41, 0.42, 0.21, 1.98,<br />
0.21, 0.01, 0.93, 0.10, 0.42, 0.31, 0.42, 0.01, 0.73 )<br />
ipd_over5<-c(<br />
28.51, 53.72, 29.53, 99.43, 43.07, 76.99, 24.39, 6.58, 46.88,<br />
17.42, 20.54, 55.04, 11.21, 25.20, 6.28, 12.76, 13.89, 9.18,<br />
4.73, 3.29, 29.03, 4.40, 5.64, 12.41, 1.43, 5.50, 11.20 )<br />
<br />
## Combine the data into 2 matrices of dimension 27*2:<br />
IPD<-cbind(ipd_under5, ipd_over5)<br />
Car<-cbind(car_under5, car_over5)<br />
<br />
## Row numbers corresponding to the 3 different PCV formulations<br />
## in matrices IPD and Car. Note: there is no serotype 5 in our data.<br />
pcv7rows<-seq(7); pcv10rows<-seq(9); pcv13rows<-seq(12)<br />
<br />
<br />
## Example S1.2A: Calculate the predicted incidence of IPD for the non-vaccine<br />
## types(NVTs) under PCV13. The predictions are calculated separately for the<br />
## two age classes. These are the values reported on the bottom panel in<br />
## Figure 2 (there given as per 100K incidences).<br />
postvacc <-Vaccination(IPD,Car,VT_rows=pcv13rows,p=1,q=1)<br />
<br />
<br />
## Example S1.2B: Decrease in IPD incidence after adding a single new serotype<br />
## to PCV13 separately for the two age categories.<br />
next_under5<-NextVT(IPD[,1],Car[,1], VT_rows=pcv13rows,p=1)<br />
next_over5 <-NextVT(IPD[,2],Car[,2], VT_rows=pcv13rows,p=1)<br />
<br />
# Nämä taulukot kannattaisi transposata niin näyttäisivät siistimmiltä.<br />
<br />
## Example S1.3A: The optimal sequence for under 5 year olds when replacement is 100%.<br />
## The output shows the decreases in IPD incidence for each step,<br />
## corresponding to Figure 5(C). The last serotype (row 27, the category "Other")<br />
## is excluded from any vaccine composition but is taken into account as a<br />
## replacing serotype at each stage.<br />
opt<-OptimalSequence(IPD[,1],Car[,1],VT_rows=0,Excluded_rows=27,p=1.0,HowmanyAdded=20)<br />
<br />
<br />
## Example S1.3B: The optimal sequence for the whole population when<br />
## replacement is 50% and the current composition includes the PCV7 serotypes.<br />
opt<-OptimalSequence(IPD,Car, VT_rows=pcv7rows,Excluded_rows=length(serotypes),<br />
p=0.5,HowmanyAdded=17)<br />
<br />
<br />
###################################<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
servac <- merge(data.frame(Vaccine = user_args$Scenario), data.frame(Serotype = serotypes))<br />
servac <- merge(<br />
data.frame(user_args$Vaccines, Result = 1), <br />
servac, <br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
#data.frame(<br />
#Vaccine = rep(c("Current", "New"), each = length(serotypes)),<br />
#Serotype = serotypes,<br />
#Result = as.numeric(c(<br />
# serotypes %in% c("19F", "23F", "6B", "14", "9V", "4", "18C", "1", "7"),<br />
# serotypes %in% servac_user<br />
# ))<br />
#))<br />
<br />
p_user<-q_user<-adultcarriers<-1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
# The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) }<br />
<br />
<br />
<br />
<br />
if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Incidence of invasive pneumococcal disease", y = "Number of cases per year")<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Age)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Incidence of invasive pneumococcal disease", y = "Number of cases per year")<br />
<br />
</rcode><br />
<br />
<br />
=== Data ===<br />
<br />
{{hidden|<br />
<br />
<t2b name='Pneumococcal carriage and IPD _' index='Serotype,Age,Observation' locations='Carriage,IPD' unit='Number of cases per year'><br />
19F|Under 5|156030|7.78<br />
23F|Under 5|156030|7.88<br />
6B|Under 5|126990|24.39<br />
14|Under 5|41200|20.76<br />
9V|Under 5|22290|2.91<br />
4|Under 5|12830|2.91<br />
18C|Under 5|10130|6.64<br />
1|Under 5|10|0.31<br />
7|Under 5|14180|3.02<br />
6A|Under 5|54940|3.94<br />
19A|Under 5|24320|9.88<br />
3|Under 5|12160|1.25<br />
8|Under 5|1350|0.1<br />
9N|Under 5|20940|0.83<br />
10|Under 5|4050|0.41<br />
11|Under 5|72270|0.42<br />
12|Under 5|10|0.21<br />
15|Under 5|33100|1.98<br />
16|Under 5|3380|0.21<br />
20|Under 5|1350|0.01<br />
22|Under 5|12160|0.93<br />
23A|Under 5|3380|0.1<br />
33|Under 5|680|0.42<br />
35|Under 5|30400|0.31<br />
38|Under 5|4050|0.42<br />
6C|Under 5|27470|0.01<br />
Oth|Under 5|24320|0.73<br />
19F|Over 5|168100|28.51<br />
23F|Over 5|314800|53.72<br />
6B|Over 5|256700|29.53<br />
14|Over 5|209800|99.43<br />
9V|Over 5|114100|43.07<br />
4|Over 5|62500|76.99<br />
18C|Over 5|200700|24.39<br />
1|Over 5|100|6.58<br />
7|Over 5|100|46.88<br />
6A|Over 5|158800|17.42<br />
19A|Over 5|54900|20.54<br />
3|Over 5|30800|55.04<br />
8|Over 5|8800|11.21<br />
9N|Over 5|8800|25.2<br />
10|Over 5|20800|6.28<br />
11|Over 5|97700|12.76<br />
12|Over 5|100|13.89<br />
15|Over 5|100|9.18<br />
16|Over 5|191900|4.73<br />
20|Over 5|25200|3.29<br />
22|Over 5|72500|29.03<br />
23A|Over 5|22000|4.4<br />
33|Over 5|100|5.64<br />
35|Over 5|71300|12.41<br />
38|Over 5|100|1.43<br />
6C|Over 5|79400|5.5<br />
Oth|Over 5|330100|11.2<br />
</t2b><br />
<br />
<t2b name="Serotypes in typical pneumococcal vaccines" index="Vaccine" obs="Serotype" unit="-"><br />
PCV10|19F<br />
PCV10|23F<br />
PCV10|6B<br />
PCV10|14<br />
PCV10|9V<br />
PCV10|4<br />
PCV10|18C<br />
PCV10|1<br />
PCV10|7<br />
PCV13|19F<br />
PCV13|23F<br />
PCV13|6B<br />
PCV13|14<br />
PCV13|9V<br />
PCV13|4<br />
PCV13|18C<br />
PCV13|1<br />
PCV13|7<br />
PCV13|3<br />
PCV13|6A<br />
PCV13|19A<br />
Existing serotypes|19F<br />
Existing serotypes|23F<br />
Existing serotypes|6B<br />
Existing serotypes|14<br />
Existing serotypes|9V<br />
Existing serotypes|4<br />
Existing serotypes|18C<br />
Existing serotypes|1<br />
Existing serotypes|7<br />
Existing serotypes|6A<br />
Existing serotypes|19A<br />
Existing serotypes|3<br />
Existing serotypes|8<br />
Existing serotypes|9N<br />
Existing serotypes|10<br />
Existing serotypes|11<br />
Existing serotypes|12<br />
Existing serotypes|15<br />
Existing serotypes|16<br />
Existing serotypes|20<br />
Existing serotypes|22<br />
Existing serotypes|23A<br />
Existing serotypes|33<br />
Existing serotypes|35<br />
Existing serotypes|38<br />
Existing serotypes|6C<br />
Existing serotypes|Oth<br />
</t2b><br />
}}<br />
<br />
=== Initiate functions (only for developers) ===<br />
<br />
<rcode name="initiate" label="Initiate functions" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
#S1.4. The R-functions<br />
###############################################################################<br />
##<br />
## R code for the core methods introduced in<br />
## Markku Nurhonen and Kari Auranen:<br />
## "Optimal serotype compositions for pneumococcal conjugate<br />
## vaccination under serotype replacement",<br />
## PLoS Computational Biology, 2014.<br />
##<br />
###############################################################################<br />
## List of arguments common to most functions:<br />
##<br />
## IPD = matrix of IPD incidences by age class (columns) and serotype (rows)<br />
## Car = corresponding matrix of carriage incidences<br />
## VT_rows = vector of the row numbers in matrices IPD and Car<br />
## corresponding to vaccine types (VT_rows=0 for no vaccination)<br />
## p = proportion of lost VT carriage which is replaced by NVT carriage<br />
## q = proportion of VT carriage lost either due to elimination or replacement<br />
##<br />
## This code includes 4 functions:<br />
## Vaccination, NextVT, OptimalSequence and OptimalVacc.<br />
##<br />
<br />
Vaccination<-function(IPD,Car,VT_rows,p,q) {<br />
##<br />
## Result:<br />
## A list of 2 matrices: IPD and carriage incidences<br />
## after vaccination (corresponding to matrices IPD and Car).<br />
## [Markku Nurhonen 2013]<br />
##<br />
if (VT_rows[1]>0) {<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
# Post vaccination carriage incidences<br />
Car_Total<-t(matrix(apply(Car,2,sum),dim(Car)[2],dim(Car)[1]))<br />
Car2<-Car; Car2[VT_rows,]<-0<br />
Car_NVT<-t(matrix(apply(Car2,2,sum),dim(Car2)[2],dim(Car2)[1]))<br />
Car_VT<-Car_Total-Car_NVT<br />
CarNew<-q*(1+p*Car_VT/Car_NVT)*Car2+(1-q)*Car<br />
# Post vaccination IPD incidences<br />
NVT_rows<-seq(dim(IPD)[1])[-1*VT_rows]<br />
# CCR=Case-to-carrier ratios<br />
CCR<-IPD/Car ; IPDNew<-0*IPD<br />
# Apply the equation appearing above<br />
# equation (1) in text for each serotype.<br />
# First term applies to NVTs.<br />
IPDNew[VT_rows,]<-(1-q)*IPD[VT_rows,]<br />
# Second term applies to NVTs.<br />
IPDNew[NVT_rows,]<-((Car_NVT+p*q*Car_VT)*(Car/Car_NVT)*CCR)[NVT_rows,]<br />
}<br />
else {<br />
IPDNew<-IPD; CarNew<-Car<br />
}<br />
list(IPDNew,CarNew) <br />
}<br />
<br />
NextVT<-function(IPD,Car,VT_rows,p) {<br />
##<br />
## Result:<br />
## A vector of decreases in IPD due to adding a serotype<br />
## to the vaccine. If VT_rows=0, initially no vaccination.<br />
## For row indexes incuded in VT_rows, the result is 0.<br />
## [Markku Nurhonen 2013]<br />
##<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
<br />
## VaccMat = IPD and Car matrices after vaccination<br />
VaccMat<-Vaccination(IPD,Car,VT_rows,p,1)<br />
IPD<-VaccMat[[1]]; Car<-VaccMat[[2]]<br />
<br />
## Total_IPD,Total_Car = Matrices corresponding to<br />
## overall IPD and carriage in each age class.<br />
Total_IPD<-t(matrix(apply(IPD,2,sum),dim(IPD)[2],dim(IPD)[1]))<br />
Total_Car<-t(matrix(apply(Car,2,sum),dim(Car)[2],dim(Car)[1]))<br />
<br />
## Effect = decrease in IPD when one serotype is added to the vaccine.<br />
## See equation (3) in text.<br />
Effect<-(Total_IPD-IPD)*((IPD/(Total_IPD-IPD))-(p*Car/(Total_Car-Car)))<br />
<br />
## Special case when only one NVT remains.<br />
IPD_nonzero<-which(apply(IPD,1,sum)!=0)<br />
if (length(IPD_nonzero)==1) {Effect[IPD_nonzero,]<-IPD[IPD_nonzero,]}<br />
<br />
## Result is obtained after summation over age classes.<br />
apply(Effect,1,sum) <br />
}<br />
<br />
OptimalSequence<-function(IPD,Car,VT_rows,Excluded_rows,p,HowmanyAdded) {<br />
##<br />
## Starting from VTs indicated by the vector VT_rows<br />
## (VT_rows=0, for no vaccination) sequentially add new VTs<br />
## to the vaccine composition s.t. at each step the optimal<br />
## serotype (corresponding to largest decrease in IPD) is added.<br />
##<br />
## Excluded_rows = Vector of indexes of the rows in matrices<br />
## IPD and Car corresponding to serotypes that are not to<br />
## be included in a vaccine composition, e.g. a row<br />
## corresponding to a group of serotypes labelled "Other".<br />
## Enter Excluded_rows=0 for no excluded serotypes.<br />
## HowmanyAdded = number of VTs to be added.<br />
##<br />
## Result:<br />
## Matrix of dimension 2*HowmanyAdded with 1st row indicating<br />
## the row numbers of added serotypes in the order they appear<br />
## in the sequence. The 2nd row lists the decreases in IPD<br />
## due to addition of each type. [Markku Nurhonen 2013]<br />
##<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
## First check the maximum possible number of added VTs.<br />
VT_howmany<-length(VT_rows)<br />
if (VT_rows[1]==0) {VT_howmany<-0}<br />
Excluded_howmany<-length(Excluded_rows)<br />
if (Excluded_rows[1]==0) {Excluded_howmany<-0}<br />
HowmanyAdded<-min(HowmanyAdded,dim(IPD)[1]-(VT_howmany+Excluded_howmany))<br />
BestVTs<-BestEffects<-rep(0,HowmanyAdded)<br />
## Sequential procedure: at each step find the best additional VT.<br />
for (i in 1:HowmanyAdded) {<br />
## Effects = Decrease in IPD after addition of each serotype<br />
Effects<-NextVT(IPD,Car,VT_rows,p)<br />
## Set Effects for VTs and excluded types equal to small values<br />
## so that none of these will be selected as the next VT.<br />
minvalue<- -2*max(abs(Effects))<br />
if (Excluded_howmany>0) {Effects[Excluded_rows]<-minvalue}<br />
if (VT_rows[1]>0) {Effects[VT_rows]<-minvalue}<br />
## BestVTs[i] = Index of serotype with maximum decrease in IPD.<br />
BestVTs[i]<-order(-1*Effects)[1]<br />
## BestEffects[i] = Decrese in IPD due to addition of BestVTs[i]<br />
## to the vaccine.<br />
BestEffects[i]<-Effects[BestVTs[i]]<br />
VT_rows<-c(VT_rows,BestVTs[i])<br />
if (VT_rows[1]==0) {VT_rows<-VT_rows[-1]}<br />
VaccMat<-Vaccination(IPD,Car,VT_rows,p,1)<br />
IPD<-VaccMat[[1]]; Car<-VaccMat[[2]] <br />
}<br />
t(matrix(c(BestVTs,BestEffects),HowmanyAdded,2)) <br />
}<br />
<br />
OptimalVacc<-function(IPD,Car,VT_rows,p,q,HowmanyAdded) {<br />
##<br />
## Result:<br />
## A list of 3 elements: (1) Row numbers of serotypes in the optimal<br />
## vaccine composition (2)-(3) IPD and carriage incidences<br />
## by serotype and age class corresponding to the optimal<br />
## vaccine formed using the sequential procedure in the<br />
## function OptimalSequence. [Markku Nurhonen 2013]<br />
##<br />
Additional_VTs<-OptimalSequence(IPD,Car,VT_rows,p,HowmanyAdded)[1,]<br />
All_VTs<-c(VT_rows,Additional_VTs)<br />
if (All_VTs[1]==0) All_VTs<-All_VTs[-1]<br />
VaccMat<-Vaccination(IPD,Car,All_VTs,p,q)<br />
list(All_VTs,VaccMat[[1]],VaccMat[[2]]) <br />
}<br />
<br />
VacCar <- Ovariable("VacCar",<br />
dependencies = data.frame(Name = c(<br />
"IPD", # incidence of pneumococcus disease<br />
"Car", # number of carriers of pneumococcus<br />
"servac", # ovariable of serotypes in vaccine (1 for serotypes in a vaccine, otherwise result is 0)<br />
"p", # proportion of eliminated VT carriage that is replaced by NVT carriage<br />
"q" # proportion of of VT carriage eliminated by vaccine<br />
)), <br />
formula = function(...) {<br />
## Result:<br />
## An ovariable of carriage incidences<br />
## after vaccination (corresponding to Car).<br />
## [Markku Nurhonen 2013, Jouni Tuomisto 2014]<br />
# Post vaccination carriage incidences<br />
<br />
# Sum over serotypes and drop extra columns<br />
#Car_Total<- unkeep(oapply(Car, cols = "Serotype", FUN = sum) * 1, prevresults = TRUE)<br />
# Car2 is a temporary ovariable with NVT carriers only<br />
#Car2 <- unkeep(Car * (1 - servac), prevresults = TRUE) # Take only NVT carriers<br />
<br />
#Car_NVT <- oapply(Car2, cols = "Serotype", FUN = sum) # Carriers of serotypes not in vaccine (NVT)<br />
#Car_VT <- Car_Total - Car_NVT # Carriers of vaccine serotypes<br />
<br />
#CarNew <- q * (1 + p * Car_VT / Car_NVT) * Car2 + (1 - q) * Car<br />
<br />
eliminated <- q * servac * Car<br />
eliminated <- unkeep(eliminated, prevresults = TRUE)<br />
<br />
replaced <- oapply(eliminated, NULL, sum, "Serotype") * p<br />
# Distribute increase evenly among non-vaccine serotypes<br />
replaced <- unkeep(1 - servac, prevresults = TRUE) / <br />
oapply(unkeep(1 - servac, prevresults = TRUE), NULL, sum, "Serotype") * <br />
replaced<br />
<br />
replaced <- unkeep(replaced, prevresults = TRUE)<br />
<br />
CarNew <- Car - eliminated + replaced<br />
return(CarNew)<br />
}<br />
)<br />
<br />
VacIPD <- Ovariable("VacIPD",<br />
dependencies = data.frame(Name = c(<br />
"IPD", # incidence of pneumococcus disease<br />
"Car", # number of carriers of pneumococcus<br />
"servac", # ovariable of serotypes in vaccine (1 for serotypes in a vaccine, otherwise result is 0)<br />
"p", # proportion of eliminated VT carriage that is replaced by NVT carriage<br />
"q" # proportion of of VT carriage eliminated by vaccine<br />
#"VacCar" # proportional serotype carriage after vaccination<br />
)), <br />
formula = function(...) {<br />
## Result:<br />
## An ovariable of IPD incidence<br />
## after vaccination (corresponding to ovariable IPD).<br />
## [Markku Nurhonen 2013, Jouni Tuomisto 2014]<br />
<br />
# Post vaccination carriage incidences (same code as in VacCar)<br />
<br />
#Car_Total <- unkeep(oapply(Car, cols = "Serotype", FUN = sum) * 1, prevresults = TRUE) # Sums over serotypes<br />
#Car2 <- unkeep(Car * (1 - servac), prevresults = TRUE)<br />
<br />
#Car_NVT <- oapply(Car2, cols = "Serotype", FUN = sum) # Carriers of serotypes not in vaccine (NVT)<br />
#Car_VT <- Car_Total - Car_NVT # Carriers of vaccine serotypes<br />
#CarNew <- q * (1 + p * Car_VT / Car_NVT) * Car2 + (1 - q) * Car<br />
<br />
# Post vaccination IPD incidences<br />
# CCR=Case-to-carrier ratios<br />
#CCR <- IPD / Car<br />
<br />
# Apply the equation appearing above<br />
# equation (1) in text for each serotype.<br />
# First term applies to VTs.<br />
#IPDNewVT <- (1 - q) * IPD * servac<br />
<br />
# Second term applies to NVTs.<br />
#IPDNewNVT <- (Car_NVT + p * q * Car_VT) * (Car / Car_NVT) * CCR * (1 - servac)<br />
<br />
#IPDNew <- IPDNewVT + IPDNewNVT<br />
<br />
#IPDNew <- IPD * unkeep(VacCar, prevresults = TRUE) / Car<br />
#IPDNew <- IPD * exp(unkeep(log(VacCar), prevresults = TRUE) - unkeep(log(Car), prevresults = TRUE))<br />
<br />
eliminated <- q * servac * Car<br />
eliminated <- unkeep(eliminated, prevresults = TRUE)<br />
<br />
replaced <- oapply(eliminated, NULL, sum, "Serotype") * p<br />
# Distribute increase evenly among non-vaccine serotypes<br />
#replaced <- unkeep(1 - servac, prevresults = TRUE) / <br />
# oapply(1 - servac, NULL, sum, "Serotype") * <br />
# replaced<br />
<br />
replaced <- unkeep(replaced, prevresults = TRUE)<br />
<br />
IPDNew <- ((1 - q * servac) + (1 - servac) * replaced / oapply((1 - servac) * Car, NULL, sum, "Serotype")) * IPD <br />
#oapply(IPDNew, IPDNew@output$Vaccine, sum)<br />
<br />
return(IPDNew) <br />
}<br />
)<br />
<br />
objects.store(Vaccination, NextVT, OptimalSequence, OptimalVacc, VacCar, VacIPD)<br />
<br />
cat("the functions Vaccination, NextVT, OptimalSequence, OptimalVacc and the ovariables VacCar, VacIPD are now saved. \n")<br />
<br />
</rcode><br />
<br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Epidemiological_modelling&diff=33312Epidemiological modelling2014-08-25T10:20:13Z<p>Mnud: </p>
<hr />
<div>[[op_fi:Epidemiologinen_malli]]<br />
{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
==Question==<br />
<br />
How to predict the net effectiveness of pneumococcal conjugate vaccination with a given set of serotypes when the vaccine is included in the national immunisation programme?<br />
<br />
* The focus is on the incidence of invasive pneumococcal disease (IPD) cases in different age groups covering the whole population.<br />
* The model is assumed to be valid in a population in which pneumococcal conjugate vaccination of infants has been in place for several years so that a new steady-state after vaccination has been reached. <br />
* The coverage of vaccination and vaccine efficacy against carriage are assumed to be high enough to justify the assumption of complete elimination of vaccine-type carriage among both the vaccinated and also, due to substantial herd effects, among the unvaccinated members of the population. <br />
* Vaccine-type carriage will be completely replaced by carriage of the non-vaccine types whose disease causing potential is not altered by vaccination.<br />
<br />
==Answer==<br />
<br />
The predicted reduction in the incidence of invasive pneumococcal disease (IPD) in different age groups are obtained from the serotype replacement model <ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref>. <br />
<br />
==Rationale==<br />
<br />
The epidemiological model for pneumococcal carriage and disease is based on the assumption that vaccination completely eliminates vaccine-type carriage in the vaccinated population and that vaccine-type carriage is completely replaced by non-vaccine-type carriage. The implications of this replacement on the decrease or increase in pneumococcal disease then depend on the disease causing potential of the replacing types compared to that of the replaced types. To predict the incidence of post-vaccination disease only pre-vaccination data on serotype-specific carriage and disease are used.<br />
<br />
The consequences of serotype replacement in the model depend on two key assumptions regarding the new steady-state after vaccination:<br />
# the relative serotype proportions among the non-vaccine types are not affected by vaccination (proportionality assumption);<br />
# the case-to-carrier ratios (the disease causing potentials) of individual serotypes remain at their pre-vaccination levels.<br />
<br />
The implications of vaccination on disease incidence are assumed to be solely due to the elimination of vaccine type carriage and its replacement by non vaccine-type carriage. An exception to this is when protective efficacy against disease without any efficacy against carriage is assumed for certain serotypes (a feature to be added).<br />
<br />
<br />
<br><br />
<br><br />
<br />
[[File:Model_kuva_simplified2.jpg|thumb|center|600px|'''Figure 1. Illustration of the replacement model.''' The incidence of pneumococcal carriage (x-axis) and case-to-carrier ratios (y-axis) for vaccine serotypes (VT) and non-vaccine serotypes (NVT) before (panel A) and after vaccination (panel B). The incidences of disease (DVT and DNVT) are obtained by multiplication of the two quantities and correspond to the areas of the rectangles. After vaccination, VT carriage is eliminated and replaced by NVT carriage (panel B). The decrease in IPD incidence after vaccination is obtained as the difference between the eliminated VT disease and the replacing NVT disease. This is the area of the blue rectangle in panel B.]]<br />
<br />
<br />
<br><br />
'''Related research'''<br><br />
The replacement model was built to reflect the accumulated 15 year long experience on use of pneumococcal conjugate vaccines worldwide and the related scientific research activity. Some of the most recent relevant publications are listed on a separate page: [[References]].<br />
<br />
'''Sensitivity analysis'''<br><br />
To assess the sensitivity of the predictions produced by the epidemiological model, <br />
effects of some alternative scenarios regarding the role of certain serotypes in PCV10 and PCV13 were calculated. <br />
In particular, these scenarios concern assumptions about indirect protection against serotype 3 under PCV13, <br />
indirect protection against serotype 6A under PCV10, and direct protection against 19A in PCV10. The detailed results are <br />
reported on a separate page: [[Sensitivity_analysis_pcv_model]]. In summary, the most influential assumptions are whether or not there will be population-level (indirect) impact on serotype 3 disease under PCV13 and serotype 6A disease under PCV10. <br />
<br />
<br><br />
<br />
<br />
<br />
=== Computation ===<br />
<br />
The following program illustrates the working of the replacement model. In its current implementation the code allows the user to specify upto 4 vaccine compositions and then displays the predicted ''number'' of IPD cases in Finland per year corresponding to these vaccines. The results are shown by serotype and by age category (<5 and 5+ year olds). Possible choices for vaccine compositions are: PCV10, PCV13, no vaccination and a user specified serotype composition. The program is based on the code in File S1 in <ref name="optimalserotype"></ref>.<br />
<br><br />
<br />
'''Instructions for user: Choose the desired vaccine compositions from the list below and then press "Run code".'''<br />
<br />
You can compare 2,3 or 4 vaccine compositions. The results will be displayed on a separate tab. The default choice is PCV10 and PCV13.<br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13;<br />
'No_vaccination';No vaccination|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:custom_vac|description:Do you want to specify another vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
<br />
name:vac_user|description:Choose the serotypes for the user defined vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE"<br />
><br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
#vacc1 <- vac<br />
#vacc2 <- custom_vac<br />
<br />
if(custom_vac) {<br />
vac <- c(vac, "UserDefined")<br />
}<br />
<br />
if (length(vac) == 0) stop("No vaccines were specified.")<br />
<br />
user_args <- list(<br />
Scenario = vac<br />
)<br />
<br />
# Ulkoinen säilö datalle jollain sivulla?<br />
temp <- data.frame(<br />
Vaccine = rep(c("PCV10", "PCV13"), c(9, 12)), <br />
Serotype = c('19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7', <br />
'19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7', '3', '6A', '19A'<br />
)<br />
)<br />
<br />
user_args$Vaccines <- temp[temp$Vaccine %in% user_args$Scenario, ]<br />
<br />
if(custom_vac) {<br />
user_args$Vaccines <- rbind(<br />
user_args$Vaccines, <br />
data.frame(Vaccine = "UserDefined", Serotype = vac_user)<br />
)<br />
}<br />
<br />
#if(!exists("servac_user")) servac_user <- c('19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7')<br />
<br />
<br />
<br />
objects.latest("Op_fi4305", code_name = "alusta") # [[Pneumokokkirokote]]<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
openv.setN(100)<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
serotypes<-c(<br />
"19F", "23F", "6B", "14", "9V", "4", "18C", "1", "7",<br />
"6A", "19A", "3", "8", "9N", "10", "11", "12", "15",<br />
"16", "20", "22", "23A", "33", "35", "38", "6C", "Oth")<br />
car_under5<-c(<br />
156030, 156030, 126990, 41200, 22290, 12830, 10130, 10, 14180,<br />
54940, 24320, 12160, 1350, 20940, 4050, 72270, 10, 33100,<br />
3380, 1350, 12160, 3380, 680, 30400, 4050, 27470, 24320 )<br />
car_over5<-c(<br />
168100, 314800, 256700, 209800, 114100, 62500, 200700, 100, 100,<br />
158800, 54900, 30800, 8800, 8800, 20800, 97700, 100, 100,<br />
191900, 25200, 72500, 22000, 100, 71300, 100, 79400, 330100 )<br />
ipd_under5<-c(<br />
7.78, 7.88, 24.39, 20.76, 2.91, 2.91, 6.64, 0.31, 3.02,<br />
3.94, 9.88, 1.25, 0.10, 0.83, 0.41, 0.42, 0.21, 1.98,<br />
0.21, 0.01, 0.93, 0.10, 0.42, 0.31, 0.42, 0.01, 0.73 )<br />
ipd_over5<-c(<br />
28.51, 53.72, 29.53, 99.43, 43.07, 76.99, 24.39, 6.58, 46.88,<br />
17.42, 20.54, 55.04, 11.21, 25.20, 6.28, 12.76, 13.89, 9.18,<br />
4.73, 3.29, 29.03, 4.40, 5.64, 12.41, 1.43, 5.50, 11.20 )<br />
<br />
## Combine the data into 2 matrices of dimension 27*2:<br />
IPD<-cbind(ipd_under5, ipd_over5)<br />
Car<-cbind(car_under5, car_over5)<br />
<br />
## Row numbers corresponding to the 3 different PCV formulations<br />
## in matrices IPD and Car. Note: there is no serotype 5 in our data.<br />
pcv7rows<-seq(7); pcv10rows<-seq(9); pcv13rows<-seq(12)<br />
<br />
<br />
## Example S1.2A: Calculate the predicted incidence of IPD for the non-vaccine<br />
## types(NVTs) under PCV13. The predictions are calculated separately for the<br />
## two age classes. These are the values reported on the bottom panel in<br />
## Figure 2 (there given as per 100K incidences).<br />
postvacc <-Vaccination(IPD,Car,VT_rows=pcv13rows,p=1,q=1)<br />
<br />
<br />
## Example S1.2B: Decrease in IPD incidence after adding a single new serotype<br />
## to PCV13 separately for the two age categories.<br />
next_under5<-NextVT(IPD[,1],Car[,1], VT_rows=pcv13rows,p=1)<br />
next_over5 <-NextVT(IPD[,2],Car[,2], VT_rows=pcv13rows,p=1)<br />
<br />
# Nämä taulukot kannattaisi transposata niin näyttäisivät siistimmiltä.<br />
<br />
## Example S1.3A: The optimal sequence for under 5 year olds when replacement is 100%.<br />
## The output shows the decreases in IPD incidence for each step,<br />
## corresponding to Figure 5(C). The last serotype (row 27, the category "Other")<br />
## is excluded from any vaccine composition but is taken into account as a<br />
## replacing serotype at each stage.<br />
opt<-OptimalSequence(IPD[,1],Car[,1],VT_rows=0,Excluded_rows=27,p=1.0,HowmanyAdded=20)<br />
<br />
<br />
## Example S1.3B: The optimal sequence for the whole population when<br />
## replacement is 50% and the current composition includes the PCV7 serotypes.<br />
opt<-OptimalSequence(IPD,Car, VT_rows=pcv7rows,Excluded_rows=length(serotypes),<br />
p=0.5,HowmanyAdded=17)<br />
<br />
<br />
###################################<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
servac <- merge(data.frame(Vaccine = user_args$Scenario), data.frame(Serotype = serotypes))<br />
servac <- merge(<br />
data.frame(user_args$Vaccines, Result = 1), <br />
servac, <br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
#data.frame(<br />
#Vaccine = rep(c("Current", "New"), each = length(serotypes)),<br />
#Serotype = serotypes,<br />
#Result = as.numeric(c(<br />
# serotypes %in% c("19F", "23F", "6B", "14", "9V", "4", "18C", "1", "7"),<br />
# serotypes %in% servac_user<br />
# ))<br />
#))<br />
<br />
p_user<-q_user<-adultcarriers<-1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
# The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) }<br />
<br />
<br />
<br />
<br />
if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Incidence of invasive pneumococcal disease", y = "Number of cases per year")<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Age)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Incidence of invasive pneumococcal disease", y = "Number of cases per year")<br />
<br />
</rcode><br />
<br />
<br />
=== Data ===<br />
<br />
{{hidden|<br />
<br />
<t2b name='Pneumococcal carriage and IPD _' index='Serotype,Age,Observation' locations='Carriage,IPD' unit='Number of cases per year'><br />
19F|Under 5|156030|7.78<br />
23F|Under 5|156030|7.88<br />
6B|Under 5|126990|24.39<br />
14|Under 5|41200|20.76<br />
9V|Under 5|22290|2.91<br />
4|Under 5|12830|2.91<br />
18C|Under 5|10130|6.64<br />
1|Under 5|10|0.31<br />
7|Under 5|14180|3.02<br />
6A|Under 5|54940|3.94<br />
19A|Under 5|24320|9.88<br />
3|Under 5|12160|1.25<br />
8|Under 5|1350|0.1<br />
9N|Under 5|20940|0.83<br />
10|Under 5|4050|0.41<br />
11|Under 5|72270|0.42<br />
12|Under 5|10|0.21<br />
15|Under 5|33100|1.98<br />
16|Under 5|3380|0.21<br />
20|Under 5|1350|0.01<br />
22|Under 5|12160|0.93<br />
23A|Under 5|3380|0.1<br />
33|Under 5|680|0.42<br />
35|Under 5|30400|0.31<br />
38|Under 5|4050|0.42<br />
6C|Under 5|27470|0.01<br />
Oth|Under 5|24320|0.73<br />
19F|Over 5|168100|28.51<br />
23F|Over 5|314800|53.72<br />
6B|Over 5|256700|29.53<br />
14|Over 5|209800|99.43<br />
9V|Over 5|114100|43.07<br />
4|Over 5|62500|76.99<br />
18C|Over 5|200700|24.39<br />
1|Over 5|100|6.58<br />
7|Over 5|100|46.88<br />
6A|Over 5|158800|17.42<br />
19A|Over 5|54900|20.54<br />
3|Over 5|30800|55.04<br />
8|Over 5|8800|11.21<br />
9N|Over 5|8800|25.2<br />
10|Over 5|20800|6.28<br />
11|Over 5|97700|12.76<br />
12|Over 5|100|13.89<br />
15|Over 5|100|9.18<br />
16|Over 5|191900|4.73<br />
20|Over 5|25200|3.29<br />
22|Over 5|72500|29.03<br />
23A|Over 5|22000|4.4<br />
33|Over 5|100|5.64<br />
35|Over 5|71300|12.41<br />
38|Over 5|100|1.43<br />
6C|Over 5|79400|5.5<br />
Oth|Over 5|330100|11.2<br />
</t2b><br />
<br />
<t2b name="Serotypes in typical pneumococcal vaccines" index="Vaccine" obs="Serotype" unit="-"><br />
PCV10|19F<br />
PCV10|23F<br />
PCV10|6B<br />
PCV10|14<br />
PCV10|9V<br />
PCV10|4<br />
PCV10|18C<br />
PCV10|1<br />
PCV10|7<br />
PCV13|19F<br />
PCV13|23F<br />
PCV13|6B<br />
PCV13|14<br />
PCV13|9V<br />
PCV13|4<br />
PCV13|18C<br />
PCV13|1<br />
PCV13|7<br />
PCV13|3<br />
PCV13|6A<br />
PCV13|19A<br />
Existing serotypes|19F<br />
Existing serotypes|23F<br />
Existing serotypes|6B<br />
Existing serotypes|14<br />
Existing serotypes|9V<br />
Existing serotypes|4<br />
Existing serotypes|18C<br />
Existing serotypes|1<br />
Existing serotypes|7<br />
Existing serotypes|6A<br />
Existing serotypes|19A<br />
Existing serotypes|3<br />
Existing serotypes|8<br />
Existing serotypes|9N<br />
Existing serotypes|10<br />
Existing serotypes|11<br />
Existing serotypes|12<br />
Existing serotypes|15<br />
Existing serotypes|16<br />
Existing serotypes|20<br />
Existing serotypes|22<br />
Existing serotypes|23A<br />
Existing serotypes|33<br />
Existing serotypes|35<br />
Existing serotypes|38<br />
Existing serotypes|6C<br />
Existing serotypes|Oth<br />
</t2b><br />
}}<br />
<br />
=== Initiate functions (only for developers) ===<br />
<br />
<rcode name="initiate" label="Initiate functions" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
#S1.4. The R-functions<br />
###############################################################################<br />
##<br />
## R code for the core methods introduced in<br />
## Markku Nurhonen and Kari Auranen:<br />
## "Optimal serotype compositions for pneumococcal conjugate<br />
## vaccination under serotype replacement",<br />
## PLoS Computational Biology, 2014.<br />
##<br />
###############################################################################<br />
## List of arguments common to most functions:<br />
##<br />
## IPD = matrix of IPD incidences by age class (columns) and serotype (rows)<br />
## Car = corresponding matrix of carriage incidences<br />
## VT_rows = vector of the row numbers in matrices IPD and Car<br />
## corresponding to vaccine types (VT_rows=0 for no vaccination)<br />
## p = proportion of lost VT carriage which is replaced by NVT carriage<br />
## q = proportion of VT carriage lost either due to elimination or replacement<br />
##<br />
## This code includes 4 functions:<br />
## Vaccination, NextVT, OptimalSequence and OptimalVacc.<br />
##<br />
<br />
Vaccination<-function(IPD,Car,VT_rows,p,q) {<br />
##<br />
## Result:<br />
## A list of 2 matrices: IPD and carriage incidences<br />
## after vaccination (corresponding to matrices IPD and Car).<br />
## [Markku Nurhonen 2013]<br />
##<br />
if (VT_rows[1]>0) {<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
# Post vaccination carriage incidences<br />
Car_Total<-t(matrix(apply(Car,2,sum),dim(Car)[2],dim(Car)[1]))<br />
Car2<-Car; Car2[VT_rows,]<-0<br />
Car_NVT<-t(matrix(apply(Car2,2,sum),dim(Car2)[2],dim(Car2)[1]))<br />
Car_VT<-Car_Total-Car_NVT<br />
CarNew<-q*(1+p*Car_VT/Car_NVT)*Car2+(1-q)*Car<br />
# Post vaccination IPD incidences<br />
NVT_rows<-seq(dim(IPD)[1])[-1*VT_rows]<br />
# CCR=Case-to-carrier ratios<br />
CCR<-IPD/Car ; IPDNew<-0*IPD<br />
# Apply the equation appearing above<br />
# equation (1) in text for each serotype.<br />
# First term applies to NVTs.<br />
IPDNew[VT_rows,]<-(1-q)*IPD[VT_rows,]<br />
# Second term applies to NVTs.<br />
IPDNew[NVT_rows,]<-((Car_NVT+p*q*Car_VT)*(Car/Car_NVT)*CCR)[NVT_rows,]<br />
}<br />
else {<br />
IPDNew<-IPD; CarNew<-Car<br />
}<br />
list(IPDNew,CarNew) <br />
}<br />
<br />
NextVT<-function(IPD,Car,VT_rows,p) {<br />
##<br />
## Result:<br />
## A vector of decreases in IPD due to adding a serotype<br />
## to the vaccine. If VT_rows=0, initially no vaccination.<br />
## For row indexes incuded in VT_rows, the result is 0.<br />
## [Markku Nurhonen 2013]<br />
##<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
<br />
## VaccMat = IPD and Car matrices after vaccination<br />
VaccMat<-Vaccination(IPD,Car,VT_rows,p,1)<br />
IPD<-VaccMat[[1]]; Car<-VaccMat[[2]]<br />
<br />
## Total_IPD,Total_Car = Matrices corresponding to<br />
## overall IPD and carriage in each age class.<br />
Total_IPD<-t(matrix(apply(IPD,2,sum),dim(IPD)[2],dim(IPD)[1]))<br />
Total_Car<-t(matrix(apply(Car,2,sum),dim(Car)[2],dim(Car)[1]))<br />
<br />
## Effect = decrease in IPD when one serotype is added to the vaccine.<br />
## See equation (3) in text.<br />
Effect<-(Total_IPD-IPD)*((IPD/(Total_IPD-IPD))-(p*Car/(Total_Car-Car)))<br />
<br />
## Special case when only one NVT remains.<br />
IPD_nonzero<-which(apply(IPD,1,sum)!=0)<br />
if (length(IPD_nonzero)==1) {Effect[IPD_nonzero,]<-IPD[IPD_nonzero,]}<br />
<br />
## Result is obtained after summation over age classes.<br />
apply(Effect,1,sum) <br />
}<br />
<br />
OptimalSequence<-function(IPD,Car,VT_rows,Excluded_rows,p,HowmanyAdded) {<br />
##<br />
## Starting from VTs indicated by the vector VT_rows<br />
## (VT_rows=0, for no vaccination) sequentially add new VTs<br />
## to the vaccine composition s.t. at each step the optimal<br />
## serotype (corresponding to largest decrease in IPD) is added.<br />
##<br />
## Excluded_rows = Vector of indexes of the rows in matrices<br />
## IPD and Car corresponding to serotypes that are not to<br />
## be included in a vaccine composition, e.g. a row<br />
## corresponding to a group of serotypes labelled "Other".<br />
## Enter Excluded_rows=0 for no excluded serotypes.<br />
## HowmanyAdded = number of VTs to be added.<br />
##<br />
## Result:<br />
## Matrix of dimension 2*HowmanyAdded with 1st row indicating<br />
## the row numbers of added serotypes in the order they appear<br />
## in the sequence. The 2nd row lists the decreases in IPD<br />
## due to addition of each type. [Markku Nurhonen 2013]<br />
##<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
## First check the maximum possible number of added VTs.<br />
VT_howmany<-length(VT_rows)<br />
if (VT_rows[1]==0) {VT_howmany<-0}<br />
Excluded_howmany<-length(Excluded_rows)<br />
if (Excluded_rows[1]==0) {Excluded_howmany<-0}<br />
HowmanyAdded<-min(HowmanyAdded,dim(IPD)[1]-(VT_howmany+Excluded_howmany))<br />
BestVTs<-BestEffects<-rep(0,HowmanyAdded)<br />
## Sequential procedure: at each step find the best additional VT.<br />
for (i in 1:HowmanyAdded) {<br />
## Effects = Decrease in IPD after addition of each serotype<br />
Effects<-NextVT(IPD,Car,VT_rows,p)<br />
## Set Effects for VTs and excluded types equal to small values<br />
## so that none of these will be selected as the next VT.<br />
minvalue<- -2*max(abs(Effects))<br />
if (Excluded_howmany>0) {Effects[Excluded_rows]<-minvalue}<br />
if (VT_rows[1]>0) {Effects[VT_rows]<-minvalue}<br />
## BestVTs[i] = Index of serotype with maximum decrease in IPD.<br />
BestVTs[i]<-order(-1*Effects)[1]<br />
## BestEffects[i] = Decrese in IPD due to addition of BestVTs[i]<br />
## to the vaccine.<br />
BestEffects[i]<-Effects[BestVTs[i]]<br />
VT_rows<-c(VT_rows,BestVTs[i])<br />
if (VT_rows[1]==0) {VT_rows<-VT_rows[-1]}<br />
VaccMat<-Vaccination(IPD,Car,VT_rows,p,1)<br />
IPD<-VaccMat[[1]]; Car<-VaccMat[[2]] <br />
}<br />
t(matrix(c(BestVTs,BestEffects),HowmanyAdded,2)) <br />
}<br />
<br />
OptimalVacc<-function(IPD,Car,VT_rows,p,q,HowmanyAdded) {<br />
##<br />
## Result:<br />
## A list of 3 elements: (1) Row numbers of serotypes in the optimal<br />
## vaccine composition (2)-(3) IPD and carriage incidences<br />
## by serotype and age class corresponding to the optimal<br />
## vaccine formed using the sequential procedure in the<br />
## function OptimalSequence. [Markku Nurhonen 2013]<br />
##<br />
Additional_VTs<-OptimalSequence(IPD,Car,VT_rows,p,HowmanyAdded)[1,]<br />
All_VTs<-c(VT_rows,Additional_VTs)<br />
if (All_VTs[1]==0) All_VTs<-All_VTs[-1]<br />
VaccMat<-Vaccination(IPD,Car,All_VTs,p,q)<br />
list(All_VTs,VaccMat[[1]],VaccMat[[2]]) <br />
}<br />
<br />
VacCar <- Ovariable("VacCar",<br />
dependencies = data.frame(Name = c(<br />
"IPD", # incidence of pneumococcus disease<br />
"Car", # number of carriers of pneumococcus<br />
"servac", # ovariable of serotypes in vaccine (1 for serotypes in a vaccine, otherwise result is 0)<br />
"p", # proportion of eliminated VT carriage that is replaced by NVT carriage<br />
"q" # proportion of of VT carriage eliminated by vaccine<br />
)), <br />
formula = function(...) {<br />
## Result:<br />
## An ovariable of carriage incidences<br />
## after vaccination (corresponding to Car).<br />
## [Markku Nurhonen 2013, Jouni Tuomisto 2014]<br />
# Post vaccination carriage incidences<br />
<br />
# Sum over serotypes and drop extra columns<br />
#Car_Total<- unkeep(oapply(Car, cols = "Serotype", FUN = sum) * 1, prevresults = TRUE)<br />
# Car2 is a temporary ovariable with NVT carriers only<br />
#Car2 <- unkeep(Car * (1 - servac), prevresults = TRUE) # Take only NVT carriers<br />
<br />
#Car_NVT <- oapply(Car2, cols = "Serotype", FUN = sum) # Carriers of serotypes not in vaccine (NVT)<br />
#Car_VT <- Car_Total - Car_NVT # Carriers of vaccine serotypes<br />
<br />
#CarNew <- q * (1 + p * Car_VT / Car_NVT) * Car2 + (1 - q) * Car<br />
<br />
eliminated <- q * servac * Car<br />
eliminated <- unkeep(eliminated, prevresults = TRUE)<br />
<br />
replaced <- oapply(eliminated, NULL, sum, "Serotype") * p<br />
# Distribute increase evenly among non-vaccine serotypes<br />
replaced <- unkeep(1 - servac, prevresults = TRUE) / <br />
oapply(unkeep(1 - servac, prevresults = TRUE), NULL, sum, "Serotype") * <br />
replaced<br />
<br />
replaced <- unkeep(replaced, prevresults = TRUE)<br />
<br />
CarNew <- Car - eliminated + replaced<br />
return(CarNew)<br />
}<br />
)<br />
<br />
VacIPD <- Ovariable("VacIPD",<br />
dependencies = data.frame(Name = c(<br />
"IPD", # incidence of pneumococcus disease<br />
"Car", # number of carriers of pneumococcus<br />
"servac", # ovariable of serotypes in vaccine (1 for serotypes in a vaccine, otherwise result is 0)<br />
"p", # proportion of eliminated VT carriage that is replaced by NVT carriage<br />
"q" # proportion of of VT carriage eliminated by vaccine<br />
#"VacCar" # proportional serotype carriage after vaccination<br />
)), <br />
formula = function(...) {<br />
## Result:<br />
## An ovariable of IPD incidence<br />
## after vaccination (corresponding to ovariable IPD).<br />
## [Markku Nurhonen 2013, Jouni Tuomisto 2014]<br />
<br />
# Post vaccination carriage incidences (same code as in VacCar)<br />
<br />
#Car_Total <- unkeep(oapply(Car, cols = "Serotype", FUN = sum) * 1, prevresults = TRUE) # Sums over serotypes<br />
#Car2 <- unkeep(Car * (1 - servac), prevresults = TRUE)<br />
<br />
#Car_NVT <- oapply(Car2, cols = "Serotype", FUN = sum) # Carriers of serotypes not in vaccine (NVT)<br />
#Car_VT <- Car_Total - Car_NVT # Carriers of vaccine serotypes<br />
#CarNew <- q * (1 + p * Car_VT / Car_NVT) * Car2 + (1 - q) * Car<br />
<br />
# Post vaccination IPD incidences<br />
# CCR=Case-to-carrier ratios<br />
#CCR <- IPD / Car<br />
<br />
# Apply the equation appearing above<br />
# equation (1) in text for each serotype.<br />
# First term applies to VTs.<br />
#IPDNewVT <- (1 - q) * IPD * servac<br />
<br />
# Second term applies to NVTs.<br />
#IPDNewNVT <- (Car_NVT + p * q * Car_VT) * (Car / Car_NVT) * CCR * (1 - servac)<br />
<br />
#IPDNew <- IPDNewVT + IPDNewNVT<br />
<br />
#IPDNew <- IPD * unkeep(VacCar, prevresults = TRUE) / Car<br />
#IPDNew <- IPD * exp(unkeep(log(VacCar), prevresults = TRUE) - unkeep(log(Car), prevresults = TRUE))<br />
<br />
eliminated <- q * servac * Car<br />
eliminated <- unkeep(eliminated, prevresults = TRUE)<br />
<br />
replaced <- oapply(eliminated, NULL, sum, "Serotype") * p<br />
# Distribute increase evenly among non-vaccine serotypes<br />
#replaced <- unkeep(1 - servac, prevresults = TRUE) / <br />
# oapply(1 - servac, NULL, sum, "Serotype") * <br />
# replaced<br />
<br />
replaced <- unkeep(replaced, prevresults = TRUE)<br />
<br />
IPDNew <- ((1 - q * servac) + (1 - servac) * replaced / oapply((1 - servac) * Car, NULL, sum, "Serotype")) * IPD <br />
#oapply(IPDNew, IPDNew@output$Vaccine, sum)<br />
<br />
return(IPDNew) <br />
}<br />
)<br />
<br />
objects.store(Vaccination, NextVT, OptimalSequence, OptimalVacc, VacCar, VacIPD)<br />
<br />
cat("the functions Vaccination, NextVT, OptimalSequence, OptimalVacc and the ovariables VacCar, VacIPD are now saved. \n")<br />
<br />
</rcode><br />
<br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Epidemiological_modelling&diff=33310Epidemiological modelling2014-08-25T10:12:32Z<p>Mnud: data table added</p>
<hr />
<div>[[op_fi:Epidemiologinen_malli]]<br />
{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
==Question==<br />
<br />
How to predict the net effectiveness of pneumococcal conjugate vaccination with a given set of serotypes when the vaccine is included in the national immunisation programme?<br />
<br />
* The focus is on the incidence of invasive pneumococcal disease (IPD) cases in different age groups covering the whole population.<br />
* The model is assumed to be valid in a population in which pneumococcal conjugate vaccination of infants has been in place for several years so that a new steady-state after vaccination has been reached. <br />
* The coverage of vaccination and vaccine efficacy against carriage are assumed to be high enough to justify the assumption of complete elimination of vaccine-type carriage among both the vaccinated and also, due to substantial herd effects, among the unvaccinated members of the population. <br />
* Vaccine-type carriage will be completely replaced by carriage of the non-vaccine types whose disease causing potential is not altered by vaccination.<br />
<br />
==Answer==<br />
<br />
The predicted reduction in the incidence of invasive pneumococcal disease (IPD) in different age groups are obtained from the serotype replacement model <ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref>. <br />
<br />
==Rationale==<br />
<br />
The epidemiological model for pneumococcal carriage and disease is based on the assumption that vaccination completely eliminates vaccine-type carriage in the vaccinated population and that vaccine-type carriage is completely replaced by non-vaccine-type carriage. The implications of this replacement on the decrease or increase in pneumococcal disease then depend on the disease causing potential of the replacing types compared to that of the replaced types. To predict the incidence of post-vaccination disease only pre-vaccination data on serotype-specific carriage and disease are used.<br />
<br />
The consequences of serotype replacement in the model depend on two key assumptions regarding the new steady-state after vaccination:<br />
# the relative serotype proportions among the non-vaccine types are not affected by vaccination (proportionality assumption);<br />
# the case-to-carrier ratios (the disease causing potentials) of individual serotypes remain at their pre-vaccination levels.<br />
<br />
The implications of vaccination on disease incidence are assumed to be solely due to the elimination of vaccine type carriage and its replacement by non vaccine-type carriage. An exception to this is when protective efficacy against disease without any efficacy against carriage is assumed for certain serotypes (a feature to be added).<br />
<br />
<br />
<br><br />
<br><br />
<br />
[[File:Model_kuva_simplified2.jpg|thumb|center|600px|'''Figure 1. Illustration of the replacement model.''' The incidence of pneumococcal carriage (x-axis) and case-to-carrier ratios (y-axis) for vaccine serotypes (VT) and non-vaccine serotypes (NVT) before (panel A) and after vaccination (panel B). The incidences of disease (DVT and DNVT) are obtained by multiplication of the two quantities and correspond to the areas of the rectangles. After vaccination, VT carriage is eliminated and replaced by NVT carriage (panel B). The decrease in IPD incidence after vaccination is obtained as the difference between the eliminated VT disease and the replacing NVT disease. This is the area of the blue rectangle in panel B.]]<br />
<br />
<br />
<br><br />
'''Related research'''<br><br />
The replacement model was built to reflect the accumulated 15 year long experience on use of pneumococcal conjugate vaccines worldwide and the related scientific research activity. Some of the most recent relevant publications are listed on a separate page: [[References]].<br />
<br />
'''Sensitivity analysis'''<br><br />
To assess the sensitivity of the predictions produced by the epidemiological model, <br />
effects of some alternative scenarios regarding the role of certain serotypes in PCV10 and PCV13 were calculated. <br />
In particular, these scenarios concern assumptions about indirect protection against serotype 3 under PCV13, <br />
indirect protection against serotype 6A under PCV10, and direct protection against 19A in PCV10. The detailed results are <br />
reported on a separate page: [[Sensitivity_analysis_pcv_model]]. In summary, the most influential assumptions are whether or not there will be population-level (indirect) impact on serotype 3 disease under PCV13 and serotype 6A disease under PCV10. <br />
<br />
<br><br />
<br />
<br />
<br />
=== Computation ===<br />
<br />
The following program illustrates the working of the replacement model. In its current implementation the code allows the user to specify 4 vaccine compositions and then displays the predicted ''number'' of IPD cases in Finland per year corresponding to these vaccines. The results are shown by serotype and by age category (<5 and 5+ year olds). Possible choices for vaccine compositions are: PCV10, PCV13, no vaccination and a user specified serotype composition. The program is based on the code in File S1 of Nurhonen and Auranen, 2014.<br />
<br />
'''Instructions for user: Choose the desired vaccine compositions from the list below and then press "Run code".'''<br />
<br />
You can compare 2,3 or 4 vaccine compositions. The results will be displayed on a separate tab. The default choice is PCV10 and PCV13.<br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13;<br />
'No_vaccination';No vaccination|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:custom_vac|description:Do you want to specify another vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
<br />
name:vac_user|description:Choose the serotypes for the user defined vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE"<br />
><br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
#vacc1 <- vac<br />
#vacc2 <- custom_vac<br />
<br />
if(custom_vac) {<br />
vac <- c(vac, "UserDefined")<br />
}<br />
<br />
if (length(vac) == 0) stop("No vaccines were specified.")<br />
<br />
user_args <- list(<br />
Scenario = vac<br />
)<br />
<br />
# Ulkoinen säilö datalle jollain sivulla?<br />
temp <- data.frame(<br />
Vaccine = rep(c("PCV10", "PCV13"), c(9, 12)), <br />
Serotype = c('19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7', <br />
'19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7', '3', '6A', '19A'<br />
)<br />
)<br />
<br />
user_args$Vaccines <- temp[temp$Vaccine %in% user_args$Scenario, ]<br />
<br />
if(custom_vac) {<br />
user_args$Vaccines <- rbind(<br />
user_args$Vaccines, <br />
data.frame(Vaccine = "UserDefined", Serotype = vac_user)<br />
)<br />
}<br />
<br />
#if(!exists("servac_user")) servac_user <- c('19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7')<br />
<br />
<br />
<br />
objects.latest("Op_fi4305", code_name = "alusta") # [[Pneumokokkirokote]]<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
openv.setN(100)<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
serotypes<-c(<br />
"19F", "23F", "6B", "14", "9V", "4", "18C", "1", "7",<br />
"6A", "19A", "3", "8", "9N", "10", "11", "12", "15",<br />
"16", "20", "22", "23A", "33", "35", "38", "6C", "Oth")<br />
car_under5<-c(<br />
156030, 156030, 126990, 41200, 22290, 12830, 10130, 10, 14180,<br />
54940, 24320, 12160, 1350, 20940, 4050, 72270, 10, 33100,<br />
3380, 1350, 12160, 3380, 680, 30400, 4050, 27470, 24320 )<br />
car_over5<-c(<br />
168100, 314800, 256700, 209800, 114100, 62500, 200700, 100, 100,<br />
158800, 54900, 30800, 8800, 8800, 20800, 97700, 100, 100,<br />
191900, 25200, 72500, 22000, 100, 71300, 100, 79400, 330100 )<br />
ipd_under5<-c(<br />
7.78, 7.88, 24.39, 20.76, 2.91, 2.91, 6.64, 0.31, 3.02,<br />
3.94, 9.88, 1.25, 0.10, 0.83, 0.41, 0.42, 0.21, 1.98,<br />
0.21, 0.01, 0.93, 0.10, 0.42, 0.31, 0.42, 0.01, 0.73 )<br />
ipd_over5<-c(<br />
28.51, 53.72, 29.53, 99.43, 43.07, 76.99, 24.39, 6.58, 46.88,<br />
17.42, 20.54, 55.04, 11.21, 25.20, 6.28, 12.76, 13.89, 9.18,<br />
4.73, 3.29, 29.03, 4.40, 5.64, 12.41, 1.43, 5.50, 11.20 )<br />
<br />
## Combine the data into 2 matrices of dimension 27*2:<br />
IPD<-cbind(ipd_under5, ipd_over5)<br />
Car<-cbind(car_under5, car_over5)<br />
<br />
## Row numbers corresponding to the 3 different PCV formulations<br />
## in matrices IPD and Car. Note: there is no serotype 5 in our data.<br />
pcv7rows<-seq(7); pcv10rows<-seq(9); pcv13rows<-seq(12)<br />
<br />
<br />
## Example S1.2A: Calculate the predicted incidence of IPD for the non-vaccine<br />
## types(NVTs) under PCV13. The predictions are calculated separately for the<br />
## two age classes. These are the values reported on the bottom panel in<br />
## Figure 2 (there given as per 100K incidences).<br />
postvacc <-Vaccination(IPD,Car,VT_rows=pcv13rows,p=1,q=1)<br />
<br />
<br />
## Example S1.2B: Decrease in IPD incidence after adding a single new serotype<br />
## to PCV13 separately for the two age categories.<br />
next_under5<-NextVT(IPD[,1],Car[,1], VT_rows=pcv13rows,p=1)<br />
next_over5 <-NextVT(IPD[,2],Car[,2], VT_rows=pcv13rows,p=1)<br />
<br />
# Nämä taulukot kannattaisi transposata niin näyttäisivät siistimmiltä.<br />
<br />
## Example S1.3A: The optimal sequence for under 5 year olds when replacement is 100%.<br />
## The output shows the decreases in IPD incidence for each step,<br />
## corresponding to Figure 5(C). The last serotype (row 27, the category "Other")<br />
## is excluded from any vaccine composition but is taken into account as a<br />
## replacing serotype at each stage.<br />
opt<-OptimalSequence(IPD[,1],Car[,1],VT_rows=0,Excluded_rows=27,p=1.0,HowmanyAdded=20)<br />
<br />
<br />
## Example S1.3B: The optimal sequence for the whole population when<br />
## replacement is 50% and the current composition includes the PCV7 serotypes.<br />
opt<-OptimalSequence(IPD,Car, VT_rows=pcv7rows,Excluded_rows=length(serotypes),<br />
p=0.5,HowmanyAdded=17)<br />
<br />
<br />
###################################<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
servac <- merge(data.frame(Vaccine = user_args$Scenario), data.frame(Serotype = serotypes))<br />
servac <- merge(<br />
data.frame(user_args$Vaccines, Result = 1), <br />
servac, <br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
#data.frame(<br />
#Vaccine = rep(c("Current", "New"), each = length(serotypes)),<br />
#Serotype = serotypes,<br />
#Result = as.numeric(c(<br />
# serotypes %in% c("19F", "23F", "6B", "14", "9V", "4", "18C", "1", "7"),<br />
# serotypes %in% servac_user<br />
# ))<br />
#))<br />
<br />
p_user<-q_user<-adultcarriers<-1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
# The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) }<br />
<br />
<br />
<br />
<br />
if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Incidence of invasive pneumococcal disease", y = "Number of cases per year")<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Age)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Incidence of invasive pneumococcal disease", y = "Number of cases per year")<br />
<br />
</rcode><br />
<br />
<br />
=== Data ===<br />
<br />
{{hidden|<br />
<br />
<t2b name='Pneumococcal carriage and IPD _' index='Serotype,Age,Observation' locations='Carriage,IPD' unit='Number of cases per year'><br />
19F|Under 5|156030|7.78<br />
23F|Under 5|156030|7.88<br />
6B|Under 5|126990|24.39<br />
14|Under 5|41200|20.76<br />
9V|Under 5|22290|2.91<br />
4|Under 5|12830|2.91<br />
18C|Under 5|10130|6.64<br />
1|Under 5|10|0.31<br />
7|Under 5|14180|3.02<br />
6A|Under 5|54940|3.94<br />
19A|Under 5|24320|9.88<br />
3|Under 5|12160|1.25<br />
8|Under 5|1350|0.1<br />
9N|Under 5|20940|0.83<br />
10|Under 5|4050|0.41<br />
11|Under 5|72270|0.42<br />
12|Under 5|10|0.21<br />
15|Under 5|33100|1.98<br />
16|Under 5|3380|0.21<br />
20|Under 5|1350|0.01<br />
22|Under 5|12160|0.93<br />
23A|Under 5|3380|0.1<br />
33|Under 5|680|0.42<br />
35|Under 5|30400|0.31<br />
38|Under 5|4050|0.42<br />
6C|Under 5|27470|0.01<br />
Oth|Under 5|24320|0.73<br />
19F|Over 5|168100|28.51<br />
23F|Over 5|314800|53.72<br />
6B|Over 5|256700|29.53<br />
14|Over 5|209800|99.43<br />
9V|Over 5|114100|43.07<br />
4|Over 5|62500|76.99<br />
18C|Over 5|200700|24.39<br />
1|Over 5|100|6.58<br />
7|Over 5|100|46.88<br />
6A|Over 5|158800|17.42<br />
19A|Over 5|54900|20.54<br />
3|Over 5|30800|55.04<br />
8|Over 5|8800|11.21<br />
9N|Over 5|8800|25.2<br />
10|Over 5|20800|6.28<br />
11|Over 5|97700|12.76<br />
12|Over 5|100|13.89<br />
15|Over 5|100|9.18<br />
16|Over 5|191900|4.73<br />
20|Over 5|25200|3.29<br />
22|Over 5|72500|29.03<br />
23A|Over 5|22000|4.4<br />
33|Over 5|100|5.64<br />
35|Over 5|71300|12.41<br />
38|Over 5|100|1.43<br />
6C|Over 5|79400|5.5<br />
Oth|Over 5|330100|11.2<br />
</t2b><br />
<br />
<t2b name="Serotypes in typical pneumococcal vaccines" index="Vaccine" obs="Serotype" unit="-"><br />
PCV10|19F<br />
PCV10|23F<br />
PCV10|6B<br />
PCV10|14<br />
PCV10|9V<br />
PCV10|4<br />
PCV10|18C<br />
PCV10|1<br />
PCV10|7<br />
PCV13|19F<br />
PCV13|23F<br />
PCV13|6B<br />
PCV13|14<br />
PCV13|9V<br />
PCV13|4<br />
PCV13|18C<br />
PCV13|1<br />
PCV13|7<br />
PCV13|3<br />
PCV13|6A<br />
PCV13|19A<br />
Existing serotypes|19F<br />
Existing serotypes|23F<br />
Existing serotypes|6B<br />
Existing serotypes|14<br />
Existing serotypes|9V<br />
Existing serotypes|4<br />
Existing serotypes|18C<br />
Existing serotypes|1<br />
Existing serotypes|7<br />
Existing serotypes|6A<br />
Existing serotypes|19A<br />
Existing serotypes|3<br />
Existing serotypes|8<br />
Existing serotypes|9N<br />
Existing serotypes|10<br />
Existing serotypes|11<br />
Existing serotypes|12<br />
Existing serotypes|15<br />
Existing serotypes|16<br />
Existing serotypes|20<br />
Existing serotypes|22<br />
Existing serotypes|23A<br />
Existing serotypes|33<br />
Existing serotypes|35<br />
Existing serotypes|38<br />
Existing serotypes|6C<br />
Existing serotypes|Oth<br />
</t2b><br />
}}<br />
<br />
=== Initiate functions (only for developers) ===<br />
<br />
<rcode name="initiate" label="Initiate functions" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
#S1.4. The R-functions<br />
###############################################################################<br />
##<br />
## R code for the core methods introduced in<br />
## Markku Nurhonen and Kari Auranen:<br />
## "Optimal serotype compositions for pneumococcal conjugate<br />
## vaccination under serotype replacement",<br />
## PLoS Computational Biology, 2014.<br />
##<br />
###############################################################################<br />
## List of arguments common to most functions:<br />
##<br />
## IPD = matrix of IPD incidences by age class (columns) and serotype (rows)<br />
## Car = corresponding matrix of carriage incidences<br />
## VT_rows = vector of the row numbers in matrices IPD and Car<br />
## corresponding to vaccine types (VT_rows=0 for no vaccination)<br />
## p = proportion of lost VT carriage which is replaced by NVT carriage<br />
## q = proportion of VT carriage lost either due to elimination or replacement<br />
##<br />
## This code includes 4 functions:<br />
## Vaccination, NextVT, OptimalSequence and OptimalVacc.<br />
##<br />
<br />
Vaccination<-function(IPD,Car,VT_rows,p,q) {<br />
##<br />
## Result:<br />
## A list of 2 matrices: IPD and carriage incidences<br />
## after vaccination (corresponding to matrices IPD and Car).<br />
## [Markku Nurhonen 2013]<br />
##<br />
if (VT_rows[1]>0) {<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
# Post vaccination carriage incidences<br />
Car_Total<-t(matrix(apply(Car,2,sum),dim(Car)[2],dim(Car)[1]))<br />
Car2<-Car; Car2[VT_rows,]<-0<br />
Car_NVT<-t(matrix(apply(Car2,2,sum),dim(Car2)[2],dim(Car2)[1]))<br />
Car_VT<-Car_Total-Car_NVT<br />
CarNew<-q*(1+p*Car_VT/Car_NVT)*Car2+(1-q)*Car<br />
# Post vaccination IPD incidences<br />
NVT_rows<-seq(dim(IPD)[1])[-1*VT_rows]<br />
# CCR=Case-to-carrier ratios<br />
CCR<-IPD/Car ; IPDNew<-0*IPD<br />
# Apply the equation appearing above<br />
# equation (1) in text for each serotype.<br />
# First term applies to NVTs.<br />
IPDNew[VT_rows,]<-(1-q)*IPD[VT_rows,]<br />
# Second term applies to NVTs.<br />
IPDNew[NVT_rows,]<-((Car_NVT+p*q*Car_VT)*(Car/Car_NVT)*CCR)[NVT_rows,]<br />
}<br />
else {<br />
IPDNew<-IPD; CarNew<-Car<br />
}<br />
list(IPDNew,CarNew) <br />
}<br />
<br />
NextVT<-function(IPD,Car,VT_rows,p) {<br />
##<br />
## Result:<br />
## A vector of decreases in IPD due to adding a serotype<br />
## to the vaccine. If VT_rows=0, initially no vaccination.<br />
## For row indexes incuded in VT_rows, the result is 0.<br />
## [Markku Nurhonen 2013]<br />
##<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
<br />
## VaccMat = IPD and Car matrices after vaccination<br />
VaccMat<-Vaccination(IPD,Car,VT_rows,p,1)<br />
IPD<-VaccMat[[1]]; Car<-VaccMat[[2]]<br />
<br />
## Total_IPD,Total_Car = Matrices corresponding to<br />
## overall IPD and carriage in each age class.<br />
Total_IPD<-t(matrix(apply(IPD,2,sum),dim(IPD)[2],dim(IPD)[1]))<br />
Total_Car<-t(matrix(apply(Car,2,sum),dim(Car)[2],dim(Car)[1]))<br />
<br />
## Effect = decrease in IPD when one serotype is added to the vaccine.<br />
## See equation (3) in text.<br />
Effect<-(Total_IPD-IPD)*((IPD/(Total_IPD-IPD))-(p*Car/(Total_Car-Car)))<br />
<br />
## Special case when only one NVT remains.<br />
IPD_nonzero<-which(apply(IPD,1,sum)!=0)<br />
if (length(IPD_nonzero)==1) {Effect[IPD_nonzero,]<-IPD[IPD_nonzero,]}<br />
<br />
## Result is obtained after summation over age classes.<br />
apply(Effect,1,sum) <br />
}<br />
<br />
OptimalSequence<-function(IPD,Car,VT_rows,Excluded_rows,p,HowmanyAdded) {<br />
##<br />
## Starting from VTs indicated by the vector VT_rows<br />
## (VT_rows=0, for no vaccination) sequentially add new VTs<br />
## to the vaccine composition s.t. at each step the optimal<br />
## serotype (corresponding to largest decrease in IPD) is added.<br />
##<br />
## Excluded_rows = Vector of indexes of the rows in matrices<br />
## IPD and Car corresponding to serotypes that are not to<br />
## be included in a vaccine composition, e.g. a row<br />
## corresponding to a group of serotypes labelled "Other".<br />
## Enter Excluded_rows=0 for no excluded serotypes.<br />
## HowmanyAdded = number of VTs to be added.<br />
##<br />
## Result:<br />
## Matrix of dimension 2*HowmanyAdded with 1st row indicating<br />
## the row numbers of added serotypes in the order they appear<br />
## in the sequence. The 2nd row lists the decreases in IPD<br />
## due to addition of each type. [Markku Nurhonen 2013]<br />
##<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
## First check the maximum possible number of added VTs.<br />
VT_howmany<-length(VT_rows)<br />
if (VT_rows[1]==0) {VT_howmany<-0}<br />
Excluded_howmany<-length(Excluded_rows)<br />
if (Excluded_rows[1]==0) {Excluded_howmany<-0}<br />
HowmanyAdded<-min(HowmanyAdded,dim(IPD)[1]-(VT_howmany+Excluded_howmany))<br />
BestVTs<-BestEffects<-rep(0,HowmanyAdded)<br />
## Sequential procedure: at each step find the best additional VT.<br />
for (i in 1:HowmanyAdded) {<br />
## Effects = Decrease in IPD after addition of each serotype<br />
Effects<-NextVT(IPD,Car,VT_rows,p)<br />
## Set Effects for VTs and excluded types equal to small values<br />
## so that none of these will be selected as the next VT.<br />
minvalue<- -2*max(abs(Effects))<br />
if (Excluded_howmany>0) {Effects[Excluded_rows]<-minvalue}<br />
if (VT_rows[1]>0) {Effects[VT_rows]<-minvalue}<br />
## BestVTs[i] = Index of serotype with maximum decrease in IPD.<br />
BestVTs[i]<-order(-1*Effects)[1]<br />
## BestEffects[i] = Decrese in IPD due to addition of BestVTs[i]<br />
## to the vaccine.<br />
BestEffects[i]<-Effects[BestVTs[i]]<br />
VT_rows<-c(VT_rows,BestVTs[i])<br />
if (VT_rows[1]==0) {VT_rows<-VT_rows[-1]}<br />
VaccMat<-Vaccination(IPD,Car,VT_rows,p,1)<br />
IPD<-VaccMat[[1]]; Car<-VaccMat[[2]] <br />
}<br />
t(matrix(c(BestVTs,BestEffects),HowmanyAdded,2)) <br />
}<br />
<br />
OptimalVacc<-function(IPD,Car,VT_rows,p,q,HowmanyAdded) {<br />
##<br />
## Result:<br />
## A list of 3 elements: (1) Row numbers of serotypes in the optimal<br />
## vaccine composition (2)-(3) IPD and carriage incidences<br />
## by serotype and age class corresponding to the optimal<br />
## vaccine formed using the sequential procedure in the<br />
## function OptimalSequence. [Markku Nurhonen 2013]<br />
##<br />
Additional_VTs<-OptimalSequence(IPD,Car,VT_rows,p,HowmanyAdded)[1,]<br />
All_VTs<-c(VT_rows,Additional_VTs)<br />
if (All_VTs[1]==0) All_VTs<-All_VTs[-1]<br />
VaccMat<-Vaccination(IPD,Car,All_VTs,p,q)<br />
list(All_VTs,VaccMat[[1]],VaccMat[[2]]) <br />
}<br />
<br />
VacCar <- Ovariable("VacCar",<br />
dependencies = data.frame(Name = c(<br />
"IPD", # incidence of pneumococcus disease<br />
"Car", # number of carriers of pneumococcus<br />
"servac", # ovariable of serotypes in vaccine (1 for serotypes in a vaccine, otherwise result is 0)<br />
"p", # proportion of eliminated VT carriage that is replaced by NVT carriage<br />
"q" # proportion of of VT carriage eliminated by vaccine<br />
)), <br />
formula = function(...) {<br />
## Result:<br />
## An ovariable of carriage incidences<br />
## after vaccination (corresponding to Car).<br />
## [Markku Nurhonen 2013, Jouni Tuomisto 2014]<br />
# Post vaccination carriage incidences<br />
<br />
# Sum over serotypes and drop extra columns<br />
#Car_Total<- unkeep(oapply(Car, cols = "Serotype", FUN = sum) * 1, prevresults = TRUE)<br />
# Car2 is a temporary ovariable with NVT carriers only<br />
#Car2 <- unkeep(Car * (1 - servac), prevresults = TRUE) # Take only NVT carriers<br />
<br />
#Car_NVT <- oapply(Car2, cols = "Serotype", FUN = sum) # Carriers of serotypes not in vaccine (NVT)<br />
#Car_VT <- Car_Total - Car_NVT # Carriers of vaccine serotypes<br />
<br />
#CarNew <- q * (1 + p * Car_VT / Car_NVT) * Car2 + (1 - q) * Car<br />
<br />
eliminated <- q * servac * Car<br />
eliminated <- unkeep(eliminated, prevresults = TRUE)<br />
<br />
replaced <- oapply(eliminated, NULL, sum, "Serotype") * p<br />
# Distribute increase evenly among non-vaccine serotypes<br />
replaced <- unkeep(1 - servac, prevresults = TRUE) / <br />
oapply(unkeep(1 - servac, prevresults = TRUE), NULL, sum, "Serotype") * <br />
replaced<br />
<br />
replaced <- unkeep(replaced, prevresults = TRUE)<br />
<br />
CarNew <- Car - eliminated + replaced<br />
return(CarNew)<br />
}<br />
)<br />
<br />
VacIPD <- Ovariable("VacIPD",<br />
dependencies = data.frame(Name = c(<br />
"IPD", # incidence of pneumococcus disease<br />
"Car", # number of carriers of pneumococcus<br />
"servac", # ovariable of serotypes in vaccine (1 for serotypes in a vaccine, otherwise result is 0)<br />
"p", # proportion of eliminated VT carriage that is replaced by NVT carriage<br />
"q" # proportion of of VT carriage eliminated by vaccine<br />
#"VacCar" # proportional serotype carriage after vaccination<br />
)), <br />
formula = function(...) {<br />
## Result:<br />
## An ovariable of IPD incidence<br />
## after vaccination (corresponding to ovariable IPD).<br />
## [Markku Nurhonen 2013, Jouni Tuomisto 2014]<br />
<br />
# Post vaccination carriage incidences (same code as in VacCar)<br />
<br />
#Car_Total <- unkeep(oapply(Car, cols = "Serotype", FUN = sum) * 1, prevresults = TRUE) # Sums over serotypes<br />
#Car2 <- unkeep(Car * (1 - servac), prevresults = TRUE)<br />
<br />
#Car_NVT <- oapply(Car2, cols = "Serotype", FUN = sum) # Carriers of serotypes not in vaccine (NVT)<br />
#Car_VT <- Car_Total - Car_NVT # Carriers of vaccine serotypes<br />
#CarNew <- q * (1 + p * Car_VT / Car_NVT) * Car2 + (1 - q) * Car<br />
<br />
# Post vaccination IPD incidences<br />
# CCR=Case-to-carrier ratios<br />
#CCR <- IPD / Car<br />
<br />
# Apply the equation appearing above<br />
# equation (1) in text for each serotype.<br />
# First term applies to VTs.<br />
#IPDNewVT <- (1 - q) * IPD * servac<br />
<br />
# Second term applies to NVTs.<br />
#IPDNewNVT <- (Car_NVT + p * q * Car_VT) * (Car / Car_NVT) * CCR * (1 - servac)<br />
<br />
#IPDNew <- IPDNewVT + IPDNewNVT<br />
<br />
#IPDNew <- IPD * unkeep(VacCar, prevresults = TRUE) / Car<br />
#IPDNew <- IPD * exp(unkeep(log(VacCar), prevresults = TRUE) - unkeep(log(Car), prevresults = TRUE))<br />
<br />
eliminated <- q * servac * Car<br />
eliminated <- unkeep(eliminated, prevresults = TRUE)<br />
<br />
replaced <- oapply(eliminated, NULL, sum, "Serotype") * p<br />
# Distribute increase evenly among non-vaccine serotypes<br />
#replaced <- unkeep(1 - servac, prevresults = TRUE) / <br />
# oapply(1 - servac, NULL, sum, "Serotype") * <br />
# replaced<br />
<br />
replaced <- unkeep(replaced, prevresults = TRUE)<br />
<br />
IPDNew <- ((1 - q * servac) + (1 - servac) * replaced / oapply((1 - servac) * Car, NULL, sum, "Serotype")) * IPD <br />
#oapply(IPDNew, IPDNew@output$Vaccine, sum)<br />
<br />
return(IPDNew) <br />
}<br />
)<br />
<br />
objects.store(Vaccination, NextVT, OptimalSequence, OptimalVacc, VacCar, VacIPD)<br />
<br />
cat("the functions Vaccination, NextVT, OptimalSequence, OptimalVacc and the ovariables VacCar, VacIPD are now saved. \n")<br />
<br />
</rcode><br />
<br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Epidemiological_modelling&diff=33308Epidemiological modelling2014-08-25T09:41:15Z<p>Mnud: </p>
<hr />
<div>[[op_fi:Epidemiologinen_malli]]<br />
{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
==Question==<br />
<br />
How to predict the net effectiveness of pneumococcal conjugate vaccination with a given set of serotypes when the vaccine is included in the national immunisation programme?<br />
<br />
* The focus is on the incidence of invasive pneumococcal disease (IPD) cases in different age groups covering the whole population.<br />
* The model is assumed to be valid in a population in which pneumococcal conjugate vaccination of infants has been in place for several years so that a new steady-state after vaccination has been reached. <br />
* The coverage of vaccination and vaccine efficacy against carriage are assumed to be high enough to justify the assumption of complete elimination of vaccine-type carriage among both the vaccinated and also, due to substantial herd effects, among the unvaccinated members of the population. <br />
* Vaccine-type carriage will be completely replaced by carriage of the non-vaccine types whose disease causing potential is not altered by vaccination.<br />
<br />
==Answer==<br />
<br />
The predicted reduction in the incidence of invasive pneumococcal disease (IPD) in different age groups are obtained from the serotype replacement model <ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref>. <br />
<br />
==Rationale==<br />
<br />
The epidemiological model for pneumococcal carriage and disease is based on the assumption that vaccination completely eliminates vaccine-type carriage in the vaccinated population and that vaccine-type carriage is completely replaced by non-vaccine-type carriage. The implications of this replacement on the decrease or increase in pneumococcal disease then depend on the disease causing potential of the replacing types compared to that of the replaced types. To predict the incidence of post-vaccination disease only pre-vaccination data on serotype-specific carriage and disease are used.<br />
<br />
The consequences of serotype replacement in the model depend on two key assumptions regarding the new steady-state after vaccination:<br />
# the relative serotype proportions among the non-vaccine types are not affected by vaccination (proportionality assumption);<br />
# the case-to-carrier ratios (the disease causing potentials) of individual serotypes remain at their pre-vaccination levels.<br />
<br />
The implications of vaccination on disease incidence are assumed to be solely due to the elimination of vaccine type carriage and its replacement by non vaccine-type carriage. An exception to this is when protective efficacy against disease without any efficacy against carriage is assumed for certain serotypes (a feature to be added).<br />
<br />
<br />
<br><br />
<br><br />
<br />
[[File:Model_kuva_simplified2.jpg|thumb|center|600px|'''Figure 1. Illustration of the replacement model.''' The incidence of pneumococcal carriage (x-axis) and case-to-carrier ratios (y-axis) for vaccine serotypes (VT) and non-vaccine serotypes (NVT) before (panel A) and after vaccination (panel B). The incidences of disease (DVT and DNVT) are obtained by multiplication of the two quantities and correspond to the areas of the rectangles. After vaccination, VT carriage is eliminated and replaced by NVT carriage (panel B). The decrease in IPD incidence after vaccination is obtained as the difference between the eliminated VT disease and the replacing NVT disease. This is the area of the blue rectangle in panel B.]]<br />
<br />
<br />
<br><br />
'''Related research'''<br><br />
The replacement model was built to reflect the accumulated 15 year long experience on use of pneumococcal conjugate vaccines worldwide and the related scientific research activity. Some of the most recent relevant publications are listed on a separate page: [[References]].<br />
<br />
'''Sensitivity analysis'''<br><br />
To assess the sensitivity of the predictions produced by the epidemiological model, <br />
effects of some alternative scenarios regarding the role of certain serotypes in PCV10 and PCV13 were calculated. <br />
In particular, these scenarios concern assumptions about indirect protection against serotype 3 under PCV13, <br />
indirect protection against serotype 6A under PCV10, and direct protection against 19A in PCV10. The detailed results are <br />
reported on a separate page: [[Sensitivity_analysis_pcv_model]]. In summary, the most influential assumptions are whether or not there will be population-level (indirect) impact on serotype 3 disease under PCV13 and serotype 6A disease under PCV10. <br />
<br />
<br><br />
<br />
<br />
<br />
=== Computation ===<br />
<br />
The following program illustrates the working of the replacement model. In its current implementation the code allows the user to specify 4 vaccine compositions and then displays the predicted ''number'' of IPD cases in Finland per year corresponding to these vaccines. The results are shown by serotype and by age category (<5 and 5+ year olds). Possible choices for vaccine compositions are: PCV10, PCV13, no vaccination and a user specified serotype composition. The program is based on the code in File S1 of Nurhonen and Auranen, 2014.<br />
<br />
'''Instructions for user: Choose the desired vaccine compositions from the list below and then press "Run code".'''<br />
<br />
You can compare 2,3 or 4 vaccine compositions. The results will be displayed on a separate tab. The default choice is PCV10 and PCV13.<br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13;<br />
'No_vaccination';No vaccination|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:custom_vac|description:Do you want to specify another vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
<br />
name:vac_user|description:Choose the serotypes for the user defined vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE"<br />
><br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
#vacc1 <- vac<br />
#vacc2 <- custom_vac<br />
<br />
if(custom_vac) {<br />
vac <- c(vac, "UserDefined")<br />
}<br />
<br />
if (length(vac) == 0) stop("No vaccines were specified.")<br />
<br />
user_args <- list(<br />
Scenario = vac<br />
)<br />
<br />
# Ulkoinen säilö datalle jollain sivulla?<br />
temp <- data.frame(<br />
Vaccine = rep(c("PCV10", "PCV13"), c(9, 12)), <br />
Serotype = c('19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7', <br />
'19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7', '3', '6A', '19A'<br />
)<br />
)<br />
<br />
user_args$Vaccines <- temp[temp$Vaccine %in% user_args$Scenario, ]<br />
<br />
if(custom_vac) {<br />
user_args$Vaccines <- rbind(<br />
user_args$Vaccines, <br />
data.frame(Vaccine = "UserDefined", Serotype = vac_user)<br />
)<br />
}<br />
<br />
#if(!exists("servac_user")) servac_user <- c('19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7')<br />
<br />
<br />
<br />
objects.latest("Op_fi4305", code_name = "alusta") # [[Pneumokokkirokote]]<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
openv.setN(100)<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
serotypes<-c(<br />
"19F", "23F", "6B", "14", "9V", "4", "18C", "1", "7",<br />
"6A", "19A", "3", "8", "9N", "10", "11", "12", "15",<br />
"16", "20", "22", "23A", "33", "35", "38", "6C", "Oth")<br />
car_under5<-c(<br />
156030, 156030, 126990, 41200, 22290, 12830, 10130, 10, 14180,<br />
54940, 24320, 12160, 1350, 20940, 4050, 72270, 10, 33100,<br />
3380, 1350, 12160, 3380, 680, 30400, 4050, 27470, 24320 )<br />
car_over5<-c(<br />
168100, 314800, 256700, 209800, 114100, 62500, 200700, 100, 100,<br />
158800, 54900, 30800, 8800, 8800, 20800, 97700, 100, 100,<br />
191900, 25200, 72500, 22000, 100, 71300, 100, 79400, 330100 )<br />
ipd_under5<-c(<br />
7.78, 7.88, 24.39, 20.76, 2.91, 2.91, 6.64, 0.31, 3.02,<br />
3.94, 9.88, 1.25, 0.10, 0.83, 0.41, 0.42, 0.21, 1.98,<br />
0.21, 0.01, 0.93, 0.10, 0.42, 0.31, 0.42, 0.01, 0.73 )<br />
ipd_over5<-c(<br />
28.51, 53.72, 29.53, 99.43, 43.07, 76.99, 24.39, 6.58, 46.88,<br />
17.42, 20.54, 55.04, 11.21, 25.20, 6.28, 12.76, 13.89, 9.18,<br />
4.73, 3.29, 29.03, 4.40, 5.64, 12.41, 1.43, 5.50, 11.20 )<br />
<br />
## Combine the data into 2 matrices of dimension 27*2:<br />
IPD<-cbind(ipd_under5, ipd_over5)<br />
Car<-cbind(car_under5, car_over5)<br />
<br />
## Row numbers corresponding to the 3 different PCV formulations<br />
## in matrices IPD and Car. Note: there is no serotype 5 in our data.<br />
pcv7rows<-seq(7); pcv10rows<-seq(9); pcv13rows<-seq(12)<br />
<br />
<br />
## Example S1.2A: Calculate the predicted incidence of IPD for the non-vaccine<br />
## types(NVTs) under PCV13. The predictions are calculated separately for the<br />
## two age classes. These are the values reported on the bottom panel in<br />
## Figure 2 (there given as per 100K incidences).<br />
postvacc <-Vaccination(IPD,Car,VT_rows=pcv13rows,p=1,q=1)<br />
<br />
<br />
## Example S1.2B: Decrease in IPD incidence after adding a single new serotype<br />
## to PCV13 separately for the two age categories.<br />
next_under5<-NextVT(IPD[,1],Car[,1], VT_rows=pcv13rows,p=1)<br />
next_over5 <-NextVT(IPD[,2],Car[,2], VT_rows=pcv13rows,p=1)<br />
<br />
# Nämä taulukot kannattaisi transposata niin näyttäisivät siistimmiltä.<br />
<br />
## Example S1.3A: The optimal sequence for under 5 year olds when replacement is 100%.<br />
## The output shows the decreases in IPD incidence for each step,<br />
## corresponding to Figure 5(C). The last serotype (row 27, the category "Other")<br />
## is excluded from any vaccine composition but is taken into account as a<br />
## replacing serotype at each stage.<br />
opt<-OptimalSequence(IPD[,1],Car[,1],VT_rows=0,Excluded_rows=27,p=1.0,HowmanyAdded=20)<br />
<br />
<br />
## Example S1.3B: The optimal sequence for the whole population when<br />
## replacement is 50% and the current composition includes the PCV7 serotypes.<br />
opt<-OptimalSequence(IPD,Car, VT_rows=pcv7rows,Excluded_rows=length(serotypes),<br />
p=0.5,HowmanyAdded=17)<br />
<br />
<br />
###################################<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
servac <- merge(data.frame(Vaccine = user_args$Scenario), data.frame(Serotype = serotypes))<br />
servac <- merge(<br />
data.frame(user_args$Vaccines, Result = 1), <br />
servac, <br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
#data.frame(<br />
#Vaccine = rep(c("Current", "New"), each = length(serotypes)),<br />
#Serotype = serotypes,<br />
#Result = as.numeric(c(<br />
# serotypes %in% c("19F", "23F", "6B", "14", "9V", "4", "18C", "1", "7"),<br />
# serotypes %in% servac_user<br />
# ))<br />
#))<br />
<br />
p_user<-q_user<-adultcarriers<-1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
# The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) }<br />
<br />
<br />
<br />
<br />
if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Incidence of invasive pneumococcal disease", y = "Number of cases per year")<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Age)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Incidence of invasive pneumococcal disease", y = "Number of cases per year")<br />
<br />
</rcode><br />
<br />
<br />
=== Data ===<br />
<br />
{{hidden|<br />
<t2b name="Serotypes in typical pneumococcal vaccines" index="Vaccine" obs="Serotype" unit="-"><br />
PCV10|19F<br />
PCV10|23F<br />
PCV10|6B<br />
PCV10|14<br />
PCV10|9V<br />
PCV10|4<br />
PCV10|18C<br />
PCV10|1<br />
PCV10|7<br />
PCV13|19F<br />
PCV13|23F<br />
PCV13|6B<br />
PCV13|14<br />
PCV13|9V<br />
PCV13|4<br />
PCV13|18C<br />
PCV13|1<br />
PCV13|7<br />
PCV13|3<br />
PCV13|6A<br />
PCV13|19A<br />
Existing serotypes|19F<br />
Existing serotypes|23F<br />
Existing serotypes|6B<br />
Existing serotypes|14<br />
Existing serotypes|9V<br />
Existing serotypes|4<br />
Existing serotypes|18C<br />
Existing serotypes|1<br />
Existing serotypes|7<br />
Existing serotypes|6A<br />
Existing serotypes|19A<br />
Existing serotypes|3<br />
Existing serotypes|8<br />
Existing serotypes|9N<br />
Existing serotypes|10<br />
Existing serotypes|11<br />
Existing serotypes|12<br />
Existing serotypes|15<br />
Existing serotypes|16<br />
Existing serotypes|20<br />
Existing serotypes|22<br />
Existing serotypes|23A<br />
Existing serotypes|33<br />
Existing serotypes|35<br />
Existing serotypes|38<br />
Existing serotypes|6C<br />
Existing serotypes|Oth<br />
</t2b><br />
}}<br />
<br />
=== Initiate functions ===<br />
<br />
<rcode name="initiate" label="Initiate functions" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
#S1.4. The R-functions<br />
###############################################################################<br />
##<br />
## R code for the core methods introduced in<br />
## Markku Nurhonen and Kari Auranen:<br />
## "Optimal serotype compositions for pneumococcal conjugate<br />
## vaccination under serotype replacement",<br />
## PLoS Computational Biology, 2014.<br />
##<br />
###############################################################################<br />
## List of arguments common to most functions:<br />
##<br />
## IPD = matrix of IPD incidences by age class (columns) and serotype (rows)<br />
## Car = corresponding matrix of carriage incidences<br />
## VT_rows = vector of the row numbers in matrices IPD and Car<br />
## corresponding to vaccine types (VT_rows=0 for no vaccination)<br />
## p = proportion of lost VT carriage which is replaced by NVT carriage<br />
## q = proportion of VT carriage lost either due to elimination or replacement<br />
##<br />
## This code includes 4 functions:<br />
## Vaccination, NextVT, OptimalSequence and OptimalVacc.<br />
##<br />
<br />
Vaccination<-function(IPD,Car,VT_rows,p,q) {<br />
##<br />
## Result:<br />
## A list of 2 matrices: IPD and carriage incidences<br />
## after vaccination (corresponding to matrices IPD and Car).<br />
## [Markku Nurhonen 2013]<br />
##<br />
if (VT_rows[1]>0) {<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
# Post vaccination carriage incidences<br />
Car_Total<-t(matrix(apply(Car,2,sum),dim(Car)[2],dim(Car)[1]))<br />
Car2<-Car; Car2[VT_rows,]<-0<br />
Car_NVT<-t(matrix(apply(Car2,2,sum),dim(Car2)[2],dim(Car2)[1]))<br />
Car_VT<-Car_Total-Car_NVT<br />
CarNew<-q*(1+p*Car_VT/Car_NVT)*Car2+(1-q)*Car<br />
# Post vaccination IPD incidences<br />
NVT_rows<-seq(dim(IPD)[1])[-1*VT_rows]<br />
# CCR=Case-to-carrier ratios<br />
CCR<-IPD/Car ; IPDNew<-0*IPD<br />
# Apply the equation appearing above<br />
# equation (1) in text for each serotype.<br />
# First term applies to NVTs.<br />
IPDNew[VT_rows,]<-(1-q)*IPD[VT_rows,]<br />
# Second term applies to NVTs.<br />
IPDNew[NVT_rows,]<-((Car_NVT+p*q*Car_VT)*(Car/Car_NVT)*CCR)[NVT_rows,]<br />
}<br />
else {<br />
IPDNew<-IPD; CarNew<-Car<br />
}<br />
list(IPDNew,CarNew) <br />
}<br />
<br />
NextVT<-function(IPD,Car,VT_rows,p) {<br />
##<br />
## Result:<br />
## A vector of decreases in IPD due to adding a serotype<br />
## to the vaccine. If VT_rows=0, initially no vaccination.<br />
## For row indexes incuded in VT_rows, the result is 0.<br />
## [Markku Nurhonen 2013]<br />
##<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
<br />
## VaccMat = IPD and Car matrices after vaccination<br />
VaccMat<-Vaccination(IPD,Car,VT_rows,p,1)<br />
IPD<-VaccMat[[1]]; Car<-VaccMat[[2]]<br />
<br />
## Total_IPD,Total_Car = Matrices corresponding to<br />
## overall IPD and carriage in each age class.<br />
Total_IPD<-t(matrix(apply(IPD,2,sum),dim(IPD)[2],dim(IPD)[1]))<br />
Total_Car<-t(matrix(apply(Car,2,sum),dim(Car)[2],dim(Car)[1]))<br />
<br />
## Effect = decrease in IPD when one serotype is added to the vaccine.<br />
## See equation (3) in text.<br />
Effect<-(Total_IPD-IPD)*((IPD/(Total_IPD-IPD))-(p*Car/(Total_Car-Car)))<br />
<br />
## Special case when only one NVT remains.<br />
IPD_nonzero<-which(apply(IPD,1,sum)!=0)<br />
if (length(IPD_nonzero)==1) {Effect[IPD_nonzero,]<-IPD[IPD_nonzero,]}<br />
<br />
## Result is obtained after summation over age classes.<br />
apply(Effect,1,sum) <br />
}<br />
<br />
OptimalSequence<-function(IPD,Car,VT_rows,Excluded_rows,p,HowmanyAdded) {<br />
##<br />
## Starting from VTs indicated by the vector VT_rows<br />
## (VT_rows=0, for no vaccination) sequentially add new VTs<br />
## to the vaccine composition s.t. at each step the optimal<br />
## serotype (corresponding to largest decrease in IPD) is added.<br />
##<br />
## Excluded_rows = Vector of indexes of the rows in matrices<br />
## IPD and Car corresponding to serotypes that are not to<br />
## be included in a vaccine composition, e.g. a row<br />
## corresponding to a group of serotypes labelled "Other".<br />
## Enter Excluded_rows=0 for no excluded serotypes.<br />
## HowmanyAdded = number of VTs to be added.<br />
##<br />
## Result:<br />
## Matrix of dimension 2*HowmanyAdded with 1st row indicating<br />
## the row numbers of added serotypes in the order they appear<br />
## in the sequence. The 2nd row lists the decreases in IPD<br />
## due to addition of each type. [Markku Nurhonen 2013]<br />
##<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
## First check the maximum possible number of added VTs.<br />
VT_howmany<-length(VT_rows)<br />
if (VT_rows[1]==0) {VT_howmany<-0}<br />
Excluded_howmany<-length(Excluded_rows)<br />
if (Excluded_rows[1]==0) {Excluded_howmany<-0}<br />
HowmanyAdded<-min(HowmanyAdded,dim(IPD)[1]-(VT_howmany+Excluded_howmany))<br />
BestVTs<-BestEffects<-rep(0,HowmanyAdded)<br />
## Sequential procedure: at each step find the best additional VT.<br />
for (i in 1:HowmanyAdded) {<br />
## Effects = Decrease in IPD after addition of each serotype<br />
Effects<-NextVT(IPD,Car,VT_rows,p)<br />
## Set Effects for VTs and excluded types equal to small values<br />
## so that none of these will be selected as the next VT.<br />
minvalue<- -2*max(abs(Effects))<br />
if (Excluded_howmany>0) {Effects[Excluded_rows]<-minvalue}<br />
if (VT_rows[1]>0) {Effects[VT_rows]<-minvalue}<br />
## BestVTs[i] = Index of serotype with maximum decrease in IPD.<br />
BestVTs[i]<-order(-1*Effects)[1]<br />
## BestEffects[i] = Decrese in IPD due to addition of BestVTs[i]<br />
## to the vaccine.<br />
BestEffects[i]<-Effects[BestVTs[i]]<br />
VT_rows<-c(VT_rows,BestVTs[i])<br />
if (VT_rows[1]==0) {VT_rows<-VT_rows[-1]}<br />
VaccMat<-Vaccination(IPD,Car,VT_rows,p,1)<br />
IPD<-VaccMat[[1]]; Car<-VaccMat[[2]] <br />
}<br />
t(matrix(c(BestVTs,BestEffects),HowmanyAdded,2)) <br />
}<br />
<br />
OptimalVacc<-function(IPD,Car,VT_rows,p,q,HowmanyAdded) {<br />
##<br />
## Result:<br />
## A list of 3 elements: (1) Row numbers of serotypes in the optimal<br />
## vaccine composition (2)-(3) IPD and carriage incidences<br />
## by serotype and age class corresponding to the optimal<br />
## vaccine formed using the sequential procedure in the<br />
## function OptimalSequence. [Markku Nurhonen 2013]<br />
##<br />
Additional_VTs<-OptimalSequence(IPD,Car,VT_rows,p,HowmanyAdded)[1,]<br />
All_VTs<-c(VT_rows,Additional_VTs)<br />
if (All_VTs[1]==0) All_VTs<-All_VTs[-1]<br />
VaccMat<-Vaccination(IPD,Car,All_VTs,p,q)<br />
list(All_VTs,VaccMat[[1]],VaccMat[[2]]) <br />
}<br />
<br />
VacCar <- Ovariable("VacCar",<br />
dependencies = data.frame(Name = c(<br />
"IPD", # incidence of pneumococcus disease<br />
"Car", # number of carriers of pneumococcus<br />
"servac", # ovariable of serotypes in vaccine (1 for serotypes in a vaccine, otherwise result is 0)<br />
"p", # proportion of eliminated VT carriage that is replaced by NVT carriage<br />
"q" # proportion of of VT carriage eliminated by vaccine<br />
)), <br />
formula = function(...) {<br />
## Result:<br />
## An ovariable of carriage incidences<br />
## after vaccination (corresponding to Car).<br />
## [Markku Nurhonen 2013, Jouni Tuomisto 2014]<br />
# Post vaccination carriage incidences<br />
<br />
# Sum over serotypes and drop extra columns<br />
#Car_Total<- unkeep(oapply(Car, cols = "Serotype", FUN = sum) * 1, prevresults = TRUE)<br />
# Car2 is a temporary ovariable with NVT carriers only<br />
#Car2 <- unkeep(Car * (1 - servac), prevresults = TRUE) # Take only NVT carriers<br />
<br />
#Car_NVT <- oapply(Car2, cols = "Serotype", FUN = sum) # Carriers of serotypes not in vaccine (NVT)<br />
#Car_VT <- Car_Total - Car_NVT # Carriers of vaccine serotypes<br />
<br />
#CarNew <- q * (1 + p * Car_VT / Car_NVT) * Car2 + (1 - q) * Car<br />
<br />
eliminated <- q * servac * Car<br />
eliminated <- unkeep(eliminated, prevresults = TRUE)<br />
<br />
replaced <- oapply(eliminated, NULL, sum, "Serotype") * p<br />
# Distribute increase evenly among non-vaccine serotypes<br />
replaced <- unkeep(1 - servac, prevresults = TRUE) / <br />
oapply(unkeep(1 - servac, prevresults = TRUE), NULL, sum, "Serotype") * <br />
replaced<br />
<br />
replaced <- unkeep(replaced, prevresults = TRUE)<br />
<br />
CarNew <- Car - eliminated + replaced<br />
return(CarNew)<br />
}<br />
)<br />
<br />
VacIPD <- Ovariable("VacIPD",<br />
dependencies = data.frame(Name = c(<br />
"IPD", # incidence of pneumococcus disease<br />
"Car", # number of carriers of pneumococcus<br />
"servac", # ovariable of serotypes in vaccine (1 for serotypes in a vaccine, otherwise result is 0)<br />
"p", # proportion of eliminated VT carriage that is replaced by NVT carriage<br />
"q" # proportion of of VT carriage eliminated by vaccine<br />
#"VacCar" # proportional serotype carriage after vaccination<br />
)), <br />
formula = function(...) {<br />
## Result:<br />
## An ovariable of IPD incidence<br />
## after vaccination (corresponding to ovariable IPD).<br />
## [Markku Nurhonen 2013, Jouni Tuomisto 2014]<br />
<br />
# Post vaccination carriage incidences (same code as in VacCar)<br />
<br />
#Car_Total <- unkeep(oapply(Car, cols = "Serotype", FUN = sum) * 1, prevresults = TRUE) # Sums over serotypes<br />
#Car2 <- unkeep(Car * (1 - servac), prevresults = TRUE)<br />
<br />
#Car_NVT <- oapply(Car2, cols = "Serotype", FUN = sum) # Carriers of serotypes not in vaccine (NVT)<br />
#Car_VT <- Car_Total - Car_NVT # Carriers of vaccine serotypes<br />
#CarNew <- q * (1 + p * Car_VT / Car_NVT) * Car2 + (1 - q) * Car<br />
<br />
# Post vaccination IPD incidences<br />
# CCR=Case-to-carrier ratios<br />
#CCR <- IPD / Car<br />
<br />
# Apply the equation appearing above<br />
# equation (1) in text for each serotype.<br />
# First term applies to VTs.<br />
#IPDNewVT <- (1 - q) * IPD * servac<br />
<br />
# Second term applies to NVTs.<br />
#IPDNewNVT <- (Car_NVT + p * q * Car_VT) * (Car / Car_NVT) * CCR * (1 - servac)<br />
<br />
#IPDNew <- IPDNewVT + IPDNewNVT<br />
<br />
#IPDNew <- IPD * unkeep(VacCar, prevresults = TRUE) / Car<br />
#IPDNew <- IPD * exp(unkeep(log(VacCar), prevresults = TRUE) - unkeep(log(Car), prevresults = TRUE))<br />
<br />
eliminated <- q * servac * Car<br />
eliminated <- unkeep(eliminated, prevresults = TRUE)<br />
<br />
replaced <- oapply(eliminated, NULL, sum, "Serotype") * p<br />
# Distribute increase evenly among non-vaccine serotypes<br />
#replaced <- unkeep(1 - servac, prevresults = TRUE) / <br />
# oapply(1 - servac, NULL, sum, "Serotype") * <br />
# replaced<br />
<br />
replaced <- unkeep(replaced, prevresults = TRUE)<br />
<br />
IPDNew <- ((1 - q * servac) + (1 - servac) * replaced / oapply((1 - servac) * Car, NULL, sum, "Serotype")) * IPD <br />
#oapply(IPDNew, IPDNew@output$Vaccine, sum)<br />
<br />
return(IPDNew) <br />
}<br />
)<br />
<br />
objects.store(Vaccination, NextVT, OptimalSequence, OptimalVacc, VacCar, VacIPD)<br />
<br />
cat("the functions Vaccination, NextVT, OptimalSequence, OptimalVacc and the ovariables VacCar, VacIPD are now saved. \n")<br />
<br />
</rcode><br />
<br />
{{hidden|<br />
oprint(IPD)<br />
}}<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33300Economic evaluation2014-08-24T21:16:52Z<p>Mnud: Table updated</p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
=== Computation ===<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. <br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:debug_plot|description:Debug plots|type:checkbox|options:1;Show all|default:1|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
#oprint(VacIPD)<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
#QALYpercase <- Ovariable("QALYpc", ddata = "Op_en6358.qalys_lost") # [[Economic evaluation]] QALYs per case<br />
<br />
#costpercase <- Ovariable("costpc", ddata = "Op_en6358.costs_incurred") # [[Economic evaluation]] QALYs per case<br />
<br />
#QALY <- VacIPD * QALYpercase <br />
<br />
#cost <- VacIPD * costpercase + vacprice<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
#oprint(Total_costs)<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
#costind <- "Vaccine"<br />
#if("Iter" %in% colnames(Total_costs@output)) costind <- c(costind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
#costsum <- oapply(Total_costs, INDEX = Total_costs@output[costind], FUN = sum)<br />
costsum <- Total_costs<br />
<br />
#oprint(costsum)<br />
#oprint(qalysum)<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
<br />
if (1==2) {<br />
oprint(<br />
qalysum, <br />
include.rownames = FALSE, <br />
caption = "QALYs lost due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
health_care_costs, <br />
include.rownames = FALSE, <br />
caption = "Health care costs due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
costsum,<br />
include.rownames = FALSE, <br />
caption = "Total costs (health care + vaccination)", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
ICER, <br />
include.rownames = FALSE, <br />
caption = "Cost-effectiveness of vaccination choices", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
sumtable(), <br />
include.rownames = FALSE, <br />
caption = "Summary table", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
if (!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
if (!is.null(debug_plot)) plot3<br />
if (!is.null(debug_plot)) plot2<br />
if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty, for debugging purposes<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
if (1==2) {<br />
oprint(<br />
oapply(VacIPD, VacIPD@output["Vaccine"], sum), <br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
<br />
vaccres<-matrix(result(VacIPD),101,3)[,c(3,1,2)]<br />
ipdsums<-apply(vaccres,2,sum)<br />
ipdtable<-data.frame(Vaccination_____=c("No vaccination ","PCV10 ","PCV13 "),N_of_IPD_cases____=round(ipdsums))<br />
<br />
oprint(ipdtable,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
) <br />
<br />
<br />
<br />
##############################<br />
## print healt care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine__ = qorder,<br />
Medical_costs__ = 0.01*round((result(health_care_costs)/1E4)[match(qorder,health_care_costs@output$Vaccine)]),<br />
Vaccine_programme_cost__ = 0.01*round(result(vacprice)/1E4),<br />
Health_care_costs__ = 0.01*round((result(costsum)/1E4)[match(qorder,costsum@output$Vaccine)])<br />
)<br />
oprint(<br />
sum_table1A,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top"<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(tekstia, include.rownames = FALSE, include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top")<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained__ = round(QALYs_gained),<br />
Incremental_effect__ = round(QALYs_incremental),<br />
Health_care_costs__ = 0.01*round(Cost_total/1E4),<br />
Incremental_cost__ = 0.01*round(Cost_incremental/1E4),<br />
ICER__ = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top"<br />
)<br />
</rcode><br />
<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Rationale == <br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER):<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
<br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Sensitivity ===<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
=== Data ===<br />
Summary table of the data applied in the cost-effectiveness analysis. <br />
<br />
1. QALY_menin = QALY losses due to meningitis (in years, *)<br />
2. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
3. CFR = Case fatality ratio for meningitis and bacteremia<br />
4. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
5. Cost_ menin = Medical costs attributed to meningitis (in euros *)<br />
6. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
7. Menin_proportion = Proportion of meningitis cases of all IPD cases<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
{| || {{prettytable}}<br />
|+Estimated medical costs and years lost due to a single bacteremia or meningitis episode <br />
| Age class || QALY_men || QALY_bac || CFR || Life_y_lost || COST_men || COST_bac || Menin_proportion<br />
|---<br />
| <5 years || 0.22 || 0.0079 || 0.014 || 31.1 || 22 070 || 1 986 || 0.037<br />
|---<br />
| 5-64 years || 0.16 || 0.0079 || 0.112 || 20.7 || 26 488 || 9 000 || 0.046<br />
|---<br />
| 65+ years || 0.08 || 0.0079 || 0.196 || 9.4 || 21 529 || 6 823 || 0.019<br />
|---<br />
|}<br />
* Note: The above table lists averages within each age class. Cost-effectiveness analysis is based on age year -specific values.<br />
<br />
<br><br />
<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost in Finland without vaccination (per year)<br />
|---<br />
|Age group||QALY_meningitis||QALY_bacteremia||Life_years_lost||Cost_meningitis||Cost_bacteremia<br />
|---<br />
|0-4y||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|5-64y||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|65+y||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
<br />
<br><br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33299Economic evaluation2014-08-24T20:54:18Z<p>Mnud: </p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
=== Computation ===<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. <br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:debug_plot|description:Debug plots|type:checkbox|options:1;Show all|default:1|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
#oprint(VacIPD)<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
#QALYpercase <- Ovariable("QALYpc", ddata = "Op_en6358.qalys_lost") # [[Economic evaluation]] QALYs per case<br />
<br />
#costpercase <- Ovariable("costpc", ddata = "Op_en6358.costs_incurred") # [[Economic evaluation]] QALYs per case<br />
<br />
#QALY <- VacIPD * QALYpercase <br />
<br />
#cost <- VacIPD * costpercase + vacprice<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
#oprint(Total_costs)<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
#costind <- "Vaccine"<br />
#if("Iter" %in% colnames(Total_costs@output)) costind <- c(costind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
#costsum <- oapply(Total_costs, INDEX = Total_costs@output[costind], FUN = sum)<br />
costsum <- Total_costs<br />
<br />
#oprint(costsum)<br />
#oprint(qalysum)<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
<br />
if (1==2) {<br />
oprint(<br />
qalysum, <br />
include.rownames = FALSE, <br />
caption = "QALYs lost due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
health_care_costs, <br />
include.rownames = FALSE, <br />
caption = "Health care costs due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
costsum,<br />
include.rownames = FALSE, <br />
caption = "Total costs (health care + vaccination)", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
ICER, <br />
include.rownames = FALSE, <br />
caption = "Cost-effectiveness of vaccination choices", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
sumtable(), <br />
include.rownames = FALSE, <br />
caption = "Summary table", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
if (!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
if (!is.null(debug_plot)) plot3<br />
if (!is.null(debug_plot)) plot2<br />
if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty, for debugging purposes<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
if (1==2) {<br />
oprint(<br />
oapply(VacIPD, VacIPD@output["Vaccine"], sum), <br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
<br />
vaccres<-matrix(result(VacIPD),101,3)[,c(3,1,2)]<br />
ipdsums<-apply(vaccres,2,sum)<br />
ipdtable<-data.frame(Vaccination_____=c("No vaccination ","PCV10 ","PCV13 "),N_of_IPD_cases____=round(ipdsums))<br />
<br />
oprint(ipdtable,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
) <br />
<br />
<br />
<br />
##############################<br />
## print healt care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine__ = qorder,<br />
Medical_costs__ = 0.01*round((result(health_care_costs)/1E4)[match(qorder,health_care_costs@output$Vaccine)]),<br />
Vaccine_programme_cost__ = 0.01*round(result(vacprice)/1E4),<br />
Health_care_costs__ = 0.01*round((result(costsum)/1E4)[match(qorder,costsum@output$Vaccine)])<br />
)<br />
oprint(<br />
sum_table1A,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top"<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(tekstia, include.rownames = FALSE, include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top")<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained__ = round(QALYs_gained),<br />
Incremental_effect__ = round(QALYs_incremental),<br />
Health_care_costs__ = 0.01*round(Cost_total/1E4),<br />
Incremental_cost__ = 0.01*round(Cost_incremental/1E4),<br />
ICER__ = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top"<br />
)<br />
</rcode><br />
<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Rationale == <br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER):<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
<br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Sensitivity ===<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
=== Data ===<br />
Summary table of the data applied in the cost-effectiveness analysis. <br />
<br />
1. QALY_menin = QALY losses due to meningitis (in years, *)<br />
2. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
3. CFR = Case fatality ratio for meningitis and bacteremia<br />
4. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
5. Cost_ menin = Medical costs attributed to meningitis (in euros *)<br />
6. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
7. Menin_proportion = Proportion of meningitis cases of all IPD cases<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
{| || {{prettytable}}<br />
|+Estimated medical costs and years lost due to a single bacteremia or meningitis episode <br />
| Age class || QALY_men || QALY_bac || CFR || Life_y_lost || COST_men || COST_bac || Menin_proportion<br />
|---<br />
| <5 years || 0.22 || 0.0079 || 0.014 || 31.0905 || 22070 || 1986 || 0.037<br />
|---<br />
| 5-64 years || 0.16 || 0.0079 || 0.112 || 20.6582 || 26488 || 9000 || 0.046<br />
|---<br />
| 65+ years || 0.08 || 0.0079 || 0.196 || 9.3755 || 21529 || 6823 || 0.019<br />
|---<br />
|}<br />
* Note: The above table lists averages within each age class. Cost-effectiveness analysis is based on age year -specific values.<br />
<br />
<br><br />
<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost in Finland without vaccination (per year)<br />
|---<br />
|Age group||QALY_meningitis||QALY_bacteremia||Life_years_lost||Cost_meningitis||Cost_bacteremia<br />
|---<br />
|0-4y||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|5-64y||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|65+y||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
<br />
<br><br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Cost_effectiveness_sensitivity&diff=33298Cost effectiveness sensitivity2014-08-24T19:12:53Z<p>Mnud: </p>
<hr />
<div>{{encyclopedia}}<br />
<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-effectiveness analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered <br />
<br />
Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important.<br />
<br />
Three separate tables are displayed, each corresponding to a different quantity. <br />
The three quantities of interest are:<br />
*PCV13adv.inIPD <br />
= (IPD under PCv10) - (IPD under PCV13)<br />
if positive, PCV13 saves IPD cases compared to PCV10<br />
*price of PCV13 <br />
= if PCV10 price set at 20e, what is the matching price for PCV13?<br />
*ICER <br />
= incremental cost-effectiveness ratio for PCV10 at price 20e<br />
(in this table, this value is also average cost per QALY)<br />
<br />
rows (vaccine composition PCV10 and its 5 modifications):<br />
[1] pcv10 <br />
[2] pcv10 + 19A(direct effects only)<br />
[3] pcv10 + 6A <br />
[4] pcv10 + 19A(direct only) + 6A<br />
[5] pcv10 + 19A(full) <br />
[6] pcv10 + 19A(full) + 6A = PCV13 - 3<br />
columns (vaccine composition PCV13 with or without serotype 3):<br />
[1] pcv13 - 3 (excluding serotype 3) <br />
[2] pcv13<br />
<br />
PCV13adv.inIPD price of PCV13 ICER<br />
============== ============== ===============<br />
PCV13-3 PCV13 PCV13-3 PCV13 PCV13-3 PCV13<br />
--- --- ------- ----- ----- ----<br />
pcv10 12 150 18 38 8077 8077<br />
pcv10+19Ad -2 134 17 37 7714 7714<br />
pcv10+6A 50 188 25 55 13590 13590<br />
pcv10+19Ad+6A 32 169 24 52 12724 12724<br />
pcv10+19Af -31 105 15 32 6198 6199<br />
pcv10+19Af+6A * 137 * 43 * 9672<br />
----------------<br />
(PCV10 price=20)</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33297Economic evaluation2014-08-24T19:00:09Z<p>Mnud: </p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
=== Computation ===<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. <br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:debug_plot|description:Debug plots|type:checkbox|options:1;Show all|default:1|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
#oprint(VacIPD)<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
#QALYpercase <- Ovariable("QALYpc", ddata = "Op_en6358.qalys_lost") # [[Economic evaluation]] QALYs per case<br />
<br />
#costpercase <- Ovariable("costpc", ddata = "Op_en6358.costs_incurred") # [[Economic evaluation]] QALYs per case<br />
<br />
#QALY <- VacIPD * QALYpercase <br />
<br />
#cost <- VacIPD * costpercase + vacprice<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
#oprint(Total_costs)<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
#costind <- "Vaccine"<br />
#if("Iter" %in% colnames(Total_costs@output)) costind <- c(costind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
#costsum <- oapply(Total_costs, INDEX = Total_costs@output[costind], FUN = sum)<br />
costsum <- Total_costs<br />
<br />
#oprint(costsum)<br />
#oprint(qalysum)<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
<br />
if (1==2) {<br />
oprint(<br />
qalysum, <br />
include.rownames = FALSE, <br />
caption = "QALYs lost due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
health_care_costs, <br />
include.rownames = FALSE, <br />
caption = "Health care costs due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
costsum,<br />
include.rownames = FALSE, <br />
caption = "Total costs (health care + vaccination)", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
ICER, <br />
include.rownames = FALSE, <br />
caption = "Cost-effectiveness of vaccination choices", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
sumtable(), <br />
include.rownames = FALSE, <br />
caption = "Summary table", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
if (!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
if (!is.null(debug_plot)) plot3<br />
if (!is.null(debug_plot)) plot2<br />
if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty, for debugging purposes<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
if (1==2) {<br />
oprint(<br />
oapply(VacIPD, VacIPD@output["Vaccine"], sum), <br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
<br />
vaccres<-matrix(result(VacIPD),101,3)[,c(3,1,2)]<br />
ipdsums<-apply(vaccres,2,sum)<br />
ipdtable<-data.frame(Vaccination_____=c("No vaccination ","PCV10 ","PCV13 "),N_of_IPD_cases____=round(ipdsums))<br />
<br />
oprint(ipdtable,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
) <br />
<br />
<br />
<br />
##############################<br />
## print healt care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine__ = qorder,<br />
Medical_costs__ = 0.01*round((result(health_care_costs)/1E4)[match(qorder,health_care_costs@output$Vaccine)]),<br />
Vaccine_programme_cost__ = 0.01*round(result(vacprice)/1E4),<br />
Health_care_costs__ = 0.01*round((result(costsum)/1E4)[match(qorder,costsum@output$Vaccine)])<br />
)<br />
oprint(<br />
sum_table1A,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top"<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(tekstia, include.rownames = FALSE, include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top")<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained__ = round(QALYs_gained),<br />
Incremental_effect__ = round(QALYs_incremental),<br />
Health_care_costs__ = 0.01*round(Cost_total/1E4),<br />
Incremental_cost__ = 0.01*round(Cost_incremental/1E4),<br />
ICER__ = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top"<br />
)<br />
</rcode><br />
<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Rationale == <br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER):<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
<br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Sensitivity ===<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
<br />
<br />
=== Data ===<br />
Summary tables of the data applied in the cost-effectiveness analysis. <br />
<br />
<br><br />
1. IPD-menin = meningitis, number of cases per year<br />
2. IPD-bact = bacteremia, number of cases per year<br />
3. QALY_menin = QALY losses due to meningitis (in years, *)<br />
4. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
5. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
6. Cost_ menin = Medical costs attributed to meningitis (in euros *)<br />
7. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost in Finland without vaccination (per year)<br />
|---<br />
|Age group||IPD_menin||IPD_bact||QALY_menin||QALY_bact||Life_y_lost||Cost_menin||Cost_bact<br />
|---<br />
|0-4y||3.70||95.3||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|5-64y||17.78||367.5||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|65+y||5.85||296.1||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost due to a single bacteremia or meningitis episode <br />
|---<br />
| Age group||QALY_menin||QALY_bact||Life_y_lost||Cost_menin||Cost_bact<br />
|---<br />
|0-4y|| 0.223||0.0079||31.0||22 070||1 986<br />
|---<br />
|5-64y|| 0.162||0.0079||20.6||26 488||9 000<br />
|---<br />
|65+y || 0.086||0.0079||9.3||21 529||6 823<br />
|---<br />
|}<br />
Note: The above table lists averages within each age class. Cost-effectiveness analysis is based on age year -specific values.<br />
<br />
<br><br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33296Economic evaluation2014-08-24T18:58:37Z<p>Mnud: </p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
=== Computation ===<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. <br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:debug_plot|description:Debug plots|type:checkbox|options:1;Show all|default:1|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
#oprint(VacIPD)<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
#QALYpercase <- Ovariable("QALYpc", ddata = "Op_en6358.qalys_lost") # [[Economic evaluation]] QALYs per case<br />
<br />
#costpercase <- Ovariable("costpc", ddata = "Op_en6358.costs_incurred") # [[Economic evaluation]] QALYs per case<br />
<br />
#QALY <- VacIPD * QALYpercase <br />
<br />
#cost <- VacIPD * costpercase + vacprice<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
#oprint(Total_costs)<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
#costind <- "Vaccine"<br />
#if("Iter" %in% colnames(Total_costs@output)) costind <- c(costind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
#costsum <- oapply(Total_costs, INDEX = Total_costs@output[costind], FUN = sum)<br />
costsum <- Total_costs<br />
<br />
#oprint(costsum)<br />
#oprint(qalysum)<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
<br />
if (1==2) {<br />
oprint(<br />
qalysum, <br />
include.rownames = FALSE, <br />
caption = "QALYs lost due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
health_care_costs, <br />
include.rownames = FALSE, <br />
caption = "Health care costs due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
costsum,<br />
include.rownames = FALSE, <br />
caption = "Total costs (health care + vaccination)", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
ICER, <br />
include.rownames = FALSE, <br />
caption = "Cost-effectiveness of vaccination choices", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
sumtable(), <br />
include.rownames = FALSE, <br />
caption = "Summary table", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
if (!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
if (!is.null(debug_plot)) plot3<br />
if (!is.null(debug_plot)) plot2<br />
if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty, for debugging purposes<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
if (1==2) {<br />
oprint(<br />
oapply(VacIPD, VacIPD@output["Vaccine"], sum), <br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
<br />
vaccres<-matrix(result(VacIPD),101,3)[,c(3,1,2)]<br />
ipdsums<-apply(vaccres,2,sum)<br />
ipdtable<-data.frame(Vaccination_____=c("No vaccination ","PCV10 ","PCV13 "),N_of_IPD_cases____=round(ipdsums))<br />
<br />
oprint(ipdtable,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
) <br />
<br />
<br />
<br />
##############################<br />
## print healt care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine__ = qorder,<br />
Medical_costs__ = 0.01*round((result(health_care_costs)/1E4)[match(qorder,health_care_costs@output$Vaccine)]),<br />
Vaccine_programme_cost__ = 0.01*round(result(vacprice)/1E4),<br />
Health_care_costs__ = 0.01*round((result(costsum)/1E4)[match(qorder,costsum@output$Vaccine)])<br />
)<br />
oprint(<br />
sum_table1A,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top"<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(tekstia, include.rownames = FALSE, include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top")<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained__ = round(QALYs_gained),<br />
Incremental_effect__ = round(QALYs_incremental),<br />
Health_care_costs__ = 0.01*round(Cost_total/1E4),<br />
Incremental_cost__ = 0.01*round(Cost_incremental/1E4),<br />
ICER__ = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top"<br />
)<br />
</rcode><br />
<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Rationale == <br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER):<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
<br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Sensitivity ===<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
<br />
<br />
=== Data ===<br />
Summary tables of the data applied in the cost-effectiveness analysis. <br />
<br />
<br><br />
1. IPD-menin = meningitis, number of cases per year<br />
2. IPD-bact = bacteremia, number of cases per year<br />
3. QALY_menin = QALY losses due to meningitis (in years, *)<br />
4. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
5. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
6. Cost_ menin = Medical costs attributed to meningitis (in euros *)<br />
7. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost per year in Finland without vaccination<br />
|---<br />
|Age group||IPD_menin||IPD_bact||QALY_menin||QALY_bact||Life_y_lost||Cost_menin||Cost_bact<br />
|---<br />
|0-4y||3.70||95.3||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|5-64y||17.78||367.5||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|65+y||5.85||296.1||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost due to a single bacteremia or meningitis episode <br />
|---<br />
| Age group||QALY_menin||QALY_bact||Life_y_lost||Cost_menin||Cost_bact<br />
|---<br />
|0-4y|| 0.223||0.0079||31.0||22 070||1 986<br />
|---<br />
|5-64y|| 0.162||0.0079||20.6||26 488||9 000<br />
|---<br />
|65+y || 0.086||0.0079||9.3||21 529||6 823<br />
|---<br />
|}<br />
Note: The above table lists averages within each age class. Cost-effectiveness analysis is based on age year -specific values.<br />
<br />
<br><br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33293Economic evaluation2014-08-24T12:55:00Z<p>Mnud: </p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
=== Computation ===<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. <br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:debug_plot|description:Debug plots|type:checkbox|options:1;Show all|default:1|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
#oprint(VacIPD)<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
#QALYpercase <- Ovariable("QALYpc", ddata = "Op_en6358.qalys_lost") # [[Economic evaluation]] QALYs per case<br />
<br />
#costpercase <- Ovariable("costpc", ddata = "Op_en6358.costs_incurred") # [[Economic evaluation]] QALYs per case<br />
<br />
#QALY <- VacIPD * QALYpercase <br />
<br />
#cost <- VacIPD * costpercase + vacprice<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
#oprint(Total_costs)<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
#costind <- "Vaccine"<br />
#if("Iter" %in% colnames(Total_costs@output)) costind <- c(costind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
#costsum <- oapply(Total_costs, INDEX = Total_costs@output[costind], FUN = sum)<br />
costsum <- Total_costs<br />
<br />
#oprint(costsum)<br />
#oprint(qalysum)<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
<br />
if (1==2) {<br />
oprint(<br />
qalysum, <br />
include.rownames = FALSE, <br />
caption = "QALYs lost due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
health_care_costs, <br />
include.rownames = FALSE, <br />
caption = "Health care costs due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
costsum,<br />
include.rownames = FALSE, <br />
caption = "Total costs (health care + vaccination)", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
ICER, <br />
include.rownames = FALSE, <br />
caption = "Cost-effectiveness of vaccination choices", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
sumtable(), <br />
include.rownames = FALSE, <br />
caption = "Summary table", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
if (!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
if (!is.null(debug_plot)) plot3<br />
if (!is.null(debug_plot)) plot2<br />
if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty, for debugging purposes<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
if (1==2) {<br />
oprint(<br />
oapply(VacIPD, VacIPD@output["Vaccine"], sum), <br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
<br />
vaccres<-matrix(result(VacIPD),101,3)[,c(3,1,2)]<br />
ipdsums<-apply(vaccres,2,sum)<br />
ipdtable<-data.frame(Vaccination_____=c("No vaccination ","PCV10 ","PCV13 "),N_of_IPD_cases____=round(ipdsums))<br />
<br />
oprint(ipdtable,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
) <br />
<br />
<br />
<br />
##############################<br />
## print healt care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine__ = qorder,<br />
Medical_costs__ = 0.01*round((result(health_care_costs)/1E4)[match(qorder,health_care_costs@output$Vaccine)]),<br />
Vaccine_programme_cost__ = 0.01*round(result(vacprice)/1E4),<br />
Health_care_costs__ = 0.01*round((result(costsum)/1E4)[match(qorder,costsum@output$Vaccine)])<br />
)<br />
oprint(<br />
sum_table1A,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top"<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(tekstia, include.rownames = FALSE, include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top")<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained__ = round(QALYs_gained),<br />
Incremental_effect__ = round(QALYs_incremental),<br />
Health_care_costs__ = 0.01*round(Cost_total/1E4),<br />
Incremental_cost__ = 0.01*round(Cost_incremental/1E4),<br />
ICER__ = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top"<br />
)<br />
</rcode><br />
<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Rationale == <br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER):<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
<br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Sensitivity ===<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
<br />
<br />
=== Data ===<br />
Summary tables of the data applied in calcuating the economic model. <br />
<br />
<br><br />
1. IPD-menin = meningitis, number of cases per year<br />
2. IPD-bact = bacteremia, number of cases per year<br />
3. QALY_menin = QALY losses due to meningitis (in years, *)<br />
4. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
5. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
6. Cost_ menin = Medical costs attributed to meningitis (in euros *)<br />
7. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost per year in Finland without vaccination<br />
|---<br />
|Age group||IPD_menin||IPD_bact||QALY_menin||QALY_bact||Life_y_lost||Cost_menin||Cost_bact<br />
|---<br />
|0-4y||3.70||95.3||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|5-64y||17.78||367.5||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|65+y||5.85||296.1||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
{|{{prettytable}}<br />
|+Estimated medical costs and years lost due to a single bacteremia or meningitis episode <br />
|---<br />
| Age group||QALY_menin||QALY_bact||Life_y_lost||Cost_menin||Cost_bact<br />
|---<br />
|0-4y|| 0.223||0.0079||31.0||22 070||1 986<br />
|---<br />
|5-64y|| 0.162||0.0079||20.6||26 488||9 000<br />
|---<br />
|65+y || 0.086||0.0079||9.3||21 529||6 823<br />
|---<br />
|}<br />
Note: The above table lists averages within each age class. The calculation is based on age year -specific values.<br />
<br />
<br><br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33292Economic evaluation2014-08-24T11:44:02Z<p>Mnud: references list created</p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
=== Computation ===<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the [[Epidemiological modelling|epidemiological model]]<ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref> to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. <br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:debug_plot|description:Debug plots|type:checkbox|options:1;Show all|default:1|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
#oprint(VacIPD)<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
#QALYpercase <- Ovariable("QALYpc", ddata = "Op_en6358.qalys_lost") # [[Economic evaluation]] QALYs per case<br />
<br />
#costpercase <- Ovariable("costpc", ddata = "Op_en6358.costs_incurred") # [[Economic evaluation]] QALYs per case<br />
<br />
#QALY <- VacIPD * QALYpercase <br />
<br />
#cost <- VacIPD * costpercase + vacprice<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
#oprint(Total_costs)<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
#costind <- "Vaccine"<br />
#if("Iter" %in% colnames(Total_costs@output)) costind <- c(costind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
#costsum <- oapply(Total_costs, INDEX = Total_costs@output[costind], FUN = sum)<br />
costsum <- Total_costs<br />
<br />
#oprint(costsum)<br />
#oprint(qalysum)<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
<br />
if (1==2) {<br />
oprint(<br />
qalysum, <br />
include.rownames = FALSE, <br />
caption = "QALYs lost due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
health_care_costs, <br />
include.rownames = FALSE, <br />
caption = "Health care costs due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
costsum,<br />
include.rownames = FALSE, <br />
caption = "Total costs (health care + vaccination)", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
ICER, <br />
include.rownames = FALSE, <br />
caption = "Cost-effectiveness of vaccination choices", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
sumtable(), <br />
include.rownames = FALSE, <br />
caption = "Summary table", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
if (!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
if (!is.null(debug_plot)) plot3<br />
if (!is.null(debug_plot)) plot2<br />
if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty, for debugging purposes<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
if (1==2) {<br />
oprint(<br />
oapply(VacIPD, VacIPD@output["Vaccine"], sum), <br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
<br />
vaccres<-matrix(result(VacIPD),101,3)[,c(3,1,2)]<br />
ipdsums<-apply(vaccres,2,sum)<br />
ipdtable<-data.frame(Vaccination_____=c("No vaccination ","PCV10 ","PCV13 "),N_of_IPD_cases____=round(ipdsums))<br />
<br />
oprint(ipdtable,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
) <br />
<br />
<br />
<br />
##############################<br />
## print healt care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine__ = qorder,<br />
Medical_costs__ = 0.01*round((result(health_care_costs)/1E4)[match(qorder,health_care_costs@output$Vaccine)]),<br />
Vaccine_programme_cost__ = 0.01*round(result(vacprice)/1E4),<br />
Health_care_costs__ = 0.01*round((result(costsum)/1E4)[match(qorder,costsum@output$Vaccine)])<br />
)<br />
oprint(<br />
sum_table1A,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top"<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(tekstia, include.rownames = FALSE, include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top")<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained__ = round(QALYs_gained),<br />
Incremental_effect__ = round(QALYs_incremental),<br />
Health_care_costs__ = 0.01*round(Cost_total/1E4),<br />
Incremental_cost__ = 0.01*round(Cost_incremental/1E4),<br />
ICER__ = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top"<br />
)<br />
</rcode><br />
<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Rationale == <br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER):<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. For a tutorial on incremental cost effectiveness analysis, see Phillips (2009) <ref name="whatis"><br />
[http://www.medicine.ox.ac.uk/bandolier/painres/download/whatis/Cost-effect.pdf? Phillips C (2009) What is cost-effectiveness? What is...? series. Hayward Medical Communications.]</ref>. <br />
<br />
<br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study <ref name="klemets">[http://www.biomedcentral.com/1471-2334/8/96 Klemets et al. (2008) Invasive pneumococcal infections among persons with and without underlying medical conditions: implications for prevention strategies. BMC Infect Dis. 2008 Jul 22;8:96.]</ref>. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Sensitivity ===<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
<br />
<br />
=== Data ===<br />
Summary tables of the data applied in calcuating the economic model. <br />
<br />
<br><br />
1. IPD-menin = meningitis, number of cases per year<br />
2. IPD-bact = bacteremia, number of cases per year<br />
3. QALY_menin = QALY losses due to meningitis (in years, *)<br />
4. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
5. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
6. Cost_ menin = Medical costs attributed to meningitis (in euros *)<br />
7. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
<br />
{|{{prettytable}}<br />
|+'''Estimated medical costs and years lost per year in Finland without vaccination'''<br />
|---<br />
|'''Age group'''||'''IPD_menin'''||'''IPD_bact'''||'''QALY_menin'''||'''QALY_bact'''||'''Life_y_lost'''||'''Cost_menin'''||'''Cost_bact'''<br />
|---<br />
|'''0-4y'''||3.70||95.3||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|'''5-64y'''||17.78||367.5||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|'''65+y'''||5.85||296.1||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
{|{{prettytable}}<br />
|+'''Estimated medical costs and years lost due to a single bacteremia or meningitis episode''' <br />
|---<br />
| '''Age group'''||'''QALY_menin'''||'''QALY_bact'''||'''Life_y_lost'''||'''Cost_menin'''||'''Cost_bact'''<br />
|---<br />
|'''0-4y'''|| 0.223||0.0079||31.0||22 070||1 986<br />
|---<br />
|'''5-64y'''|| 0.162||0.0079||20.6||26 488||9 000<br />
|---<br />
|'''65+y''' || 0.086||0.0079||9.3||21 529||6 823<br />
|---<br />
|}<br />
<br />
<br><br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Epidemiological_modelling&diff=33291Epidemiological modelling2014-08-24T11:33:00Z<p>Mnud: </p>
<hr />
<div>[[op_fi:Epidemiologinen_malli]]<br />
{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
==Question==<br />
<br />
How to predict the net effectiveness of pneumococcal conjugate vaccination with a given set of serotypes when the vaccine is included in the national immunisation programme?<br />
<br />
* The focus is on the incidence of invasive pneumococcal disease (IPD) cases in different age groups covering the whole population.<br />
* The model is assumed to be valid in a population in which pneumococcal conjugate vaccination of infants has been in place for several years so that a new steady-state after vaccination has been reached. <br />
* The coverage of vaccination and vaccine efficacy against carriage are assumed to be high enough to justify the assumption of complete elimination of vaccine-type carriage among both the vaccinated and also, due to substantial herd effects, among the unvaccinated members of the population. <br />
* Vaccine-type carriage will be completely replaced by carriage of the non-vaccine types whose disease causing potential is not altered by vaccination.<br />
<br />
==Answer==<br />
<br />
The predicted reduction in the incidence of invasive pneumococcal disease (IPD) in different age groups are obtained from the serotype replacement model <ref name="optimalserotype">[http://www.ploscompbiol.org/article/info%3Adoi%2F10.1371%2Fjournal.pcbi.1003477 Nurhonen M, Auranen K (2014) Optimal Serotype Compositions for Pneumococcal Conjugate Vaccination under Serotype Replacement. PLoS Comput Biol 10(2): e1003477. doi:10.1371/journal.pcbi.1003477]</ref>. <br />
<br />
==Rationale==<br />
<br />
The epidemiological model for pneumococcal carriage and disease is based on the assumption that vaccination completely eliminates vaccine-type carriage in the vaccinated population and that vaccine-type carriage is completely replaced by non-vaccine-type carriage. The implications of this replacement on the decrease or increase in pneumococcal disease then depend on the disease causing potential of the replacing types compared to that of the replaced types. To predict the incidence of post-vaccination disease only pre-vaccination data on serotype-specific carriage and disease are used.<br />
<br />
The consequences of serotype replacement in the model depend on two key assumptions regarding the new steady-state after vaccination:<br />
# the relative serotype proportions among the non-vaccine types are not affected by vaccination (proportionality assumption);<br />
# the case-to-carrier ratios (the disease causing potentials) of individual serotypes remain at their pre-vaccination levels.<br />
<br />
The implications of vaccination on disease incidence are assumed to be solely due to the elimination of vaccine type carriage and its replacement by non vaccine-type carriage. An exception to this is when protective efficacy against disease without any efficacy against carriage is assumed for certain serotypes (a feature to be added).<br />
<br />
<br />
<br><br />
<br><br />
<br />
[[File:Model_kuva_simplified2.jpg|thumb|center|600px|'''Figure 1. Illustration of the replacement model.''' The incidence of pneumococcal carriage (x-axis) and case-to-carrier ratios (y-axis) for vaccine serotypes (VT) and non-vaccine serotypes (NVT) before (panel A) and after vaccination (panel B). The incidences of disease (DVT and DNVT) are obtained by multiplication of the two quantities and correspond to the areas of the rectangles. After vaccination, VT carriage is eliminated and replaced by NVT carriage (panel B). The decrease in IPD incidence after vaccination is obtained as the difference between the eliminated VT disease and the replacing NVT disease. This is the area of the blue rectangle in panel B.]]<br />
<br />
<br />
<br><br />
'''Related research'''<br><br />
The replacement model was built to reflect the accumulated 15 year long experience on use of pneumococcal conjugate vaccines worldwide and the related scientific research activity. Some of the most recent relevant publications are listed on a separate page: [[References]].<br />
<br />
'''Sensitivity analysis'''<br><br />
To assess the sensitivity of the predictions produced by the epidemiological model, <br />
effects of some alternative scenarios regarding the role of certain serotypes in PCV10 and PCV13 were calculated. <br />
In particular, these scenarios concern assumptions about indirect protection against serotype 3 under PCV13, <br />
indirect protection against serotype 6A under PCV10, and direct protection against 19A in PCV10. The detailed results are <br />
reported on a separate page: [[Sensitivity_analysis_pcv_model]]. In summary, the most influential assumptions are whether or not there will be population-level (indirect) impact on serotype 3 disease under PCV13 and serotype 6A disease under PCV10. <br />
<br />
<br><br />
<br />
<br />
<br />
=== Computation ===<br />
<br />
The following program illustrates the working of the replacement model. In its current implementation the code allows the user to specify 4 vaccine compositions and then displays the predicted ''number'' of IPD cases in Finland per year corresponding to these vaccines. The results are shown by serotype and by age category (<5 and 5+ year olds). Possible choices for vaccine compositions are: PCV10, PCV13, no vaccination and a user specified serotype composition. The program is based on the code in File S1 of Nurhonen and Auranen, 2014.<br />
<br />
'''Instructions for user: Choose the desired vaccine compositions from the list below and then press "Run code".'''<br />
<br />
You can compare 2,3 or 4 vaccine compositions. The results will be displayed on a separate tab. The default choice is PCV10 and PCV13.<br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13;<br />
'No_vaccination';No vaccination|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:custom_vac|description:Do you want to specify another vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
<br />
name:vac_user|description:Choose the serotypes for the user defined vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE"<br />
><br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
#vacc1 <- vac<br />
#vacc2 <- custom_vac<br />
<br />
if(custom_vac) {<br />
vac <- c(vac, "UserDefined")<br />
}<br />
<br />
if (length(vac) == 0) stop("No vaccines were specified.")<br />
<br />
user_args <- list(<br />
Scenario = vac<br />
)<br />
<br />
# Ulkoinen säilö datalle jollain sivulla?<br />
temp <- data.frame(<br />
Vaccine = rep(c("PCV10", "PCV13"), c(9, 12)), <br />
Serotype = c('19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7', <br />
'19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7', '3', '6A', '19A'<br />
)<br />
)<br />
<br />
user_args$Vaccines <- temp[temp$Vaccine %in% user_args$Scenario, ]<br />
<br />
if(custom_vac) {<br />
user_args$Vaccines <- rbind(<br />
user_args$Vaccines, <br />
data.frame(Vaccine = "UserDefined", Serotype = vac_user)<br />
)<br />
}<br />
<br />
#if(!exists("servac_user")) servac_user <- c('19F', '23F', '6B', '14', '9V', '4', '18C', '1', '7')<br />
<br />
<br />
<br />
objects.latest("Op_fi4305", code_name = "alusta") # [[Pneumokokkirokote]]<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
openv.setN(100)<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
serotypes<-c(<br />
"19F", "23F", "6B", "14", "9V", "4", "18C", "1", "7",<br />
"6A", "19A", "3", "8", "9N", "10", "11", "12", "15",<br />
"16", "20", "22", "23A", "33", "35", "38", "6C", "Oth")<br />
car_under5<-c(<br />
156030, 156030, 126990, 41200, 22290, 12830, 10130, 10, 14180,<br />
54940, 24320, 12160, 1350, 20940, 4050, 72270, 10, 33100,<br />
3380, 1350, 12160, 3380, 680, 30400, 4050, 27470, 24320 )<br />
car_over5<-c(<br />
168100, 314800, 256700, 209800, 114100, 62500, 200700, 100, 100,<br />
158800, 54900, 30800, 8800, 8800, 20800, 97700, 100, 100,<br />
191900, 25200, 72500, 22000, 100, 71300, 100, 79400, 330100 )<br />
ipd_under5<-c(<br />
7.78, 7.88, 24.39, 20.76, 2.91, 2.91, 6.64, 0.31, 3.02,<br />
3.94, 9.88, 1.25, 0.10, 0.83, 0.41, 0.42, 0.21, 1.98,<br />
0.21, 0.01, 0.93, 0.10, 0.42, 0.31, 0.42, 0.01, 0.73 )<br />
ipd_over5<-c(<br />
28.51, 53.72, 29.53, 99.43, 43.07, 76.99, 24.39, 6.58, 46.88,<br />
17.42, 20.54, 55.04, 11.21, 25.20, 6.28, 12.76, 13.89, 9.18,<br />
4.73, 3.29, 29.03, 4.40, 5.64, 12.41, 1.43, 5.50, 11.20 )<br />
<br />
## Combine the data into 2 matrices of dimension 27*2:<br />
IPD<-cbind(ipd_under5, ipd_over5)<br />
Car<-cbind(car_under5, car_over5)<br />
<br />
## Row numbers corresponding to the 3 different PCV formulations<br />
## in matrices IPD and Car. Note: there is no serotype 5 in our data.<br />
pcv7rows<-seq(7); pcv10rows<-seq(9); pcv13rows<-seq(12)<br />
<br />
<br />
## Example S1.2A: Calculate the predicted incidence of IPD for the non-vaccine<br />
## types(NVTs) under PCV13. The predictions are calculated separately for the<br />
## two age classes. These are the values reported on the bottom panel in<br />
## Figure 2 (there given as per 100K incidences).<br />
postvacc <-Vaccination(IPD,Car,VT_rows=pcv13rows,p=1,q=1)<br />
<br />
<br />
## Example S1.2B: Decrease in IPD incidence after adding a single new serotype<br />
## to PCV13 separately for the two age categories.<br />
next_under5<-NextVT(IPD[,1],Car[,1], VT_rows=pcv13rows,p=1)<br />
next_over5 <-NextVT(IPD[,2],Car[,2], VT_rows=pcv13rows,p=1)<br />
<br />
# Nämä taulukot kannattaisi transposata niin näyttäisivät siistimmiltä.<br />
<br />
## Example S1.3A: The optimal sequence for under 5 year olds when replacement is 100%.<br />
## The output shows the decreases in IPD incidence for each step,<br />
## corresponding to Figure 5(C). The last serotype (row 27, the category "Other")<br />
## is excluded from any vaccine composition but is taken into account as a<br />
## replacing serotype at each stage.<br />
opt<-OptimalSequence(IPD[,1],Car[,1],VT_rows=0,Excluded_rows=27,p=1.0,HowmanyAdded=20)<br />
<br />
<br />
## Example S1.3B: The optimal sequence for the whole population when<br />
## replacement is 50% and the current composition includes the PCV7 serotypes.<br />
opt<-OptimalSequence(IPD,Car, VT_rows=pcv7rows,Excluded_rows=length(serotypes),<br />
p=0.5,HowmanyAdded=17)<br />
<br />
<br />
###################################<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
servac <- merge(data.frame(Vaccine = user_args$Scenario), data.frame(Serotype = serotypes))<br />
servac <- merge(<br />
data.frame(user_args$Vaccines, Result = 1), <br />
servac, <br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
#data.frame(<br />
#Vaccine = rep(c("Current", "New"), each = length(serotypes)),<br />
#Serotype = serotypes,<br />
#Result = as.numeric(c(<br />
# serotypes %in% c("19F", "23F", "6B", "14", "9V", "4", "18C", "1", "7"),<br />
# serotypes %in% servac_user<br />
# ))<br />
#))<br />
<br />
p_user<-q_user<-adultcarriers<-1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
# The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) }<br />
<br />
<br />
<br />
<br />
if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Incidence of invasive pneumococcal disease", y = "Number of cases per year")<br />
<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Age)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Incidence of invasive pneumococcal disease", y = "Number of cases per year")<br />
<br />
</rcode><br />
<br />
<br />
=== Data ===<br />
<br />
{{hidden|<br />
<t2b name="Serotypes in typical pneumococcal vaccines" index="Vaccine" obs="Serotype" unit="-"><br />
PCV10|19F<br />
PCV10|23F<br />
PCV10|6B<br />
PCV10|14<br />
PCV10|9V<br />
PCV10|4<br />
PCV10|18C<br />
PCV10|1<br />
PCV10|7<br />
PCV13|19F<br />
PCV13|23F<br />
PCV13|6B<br />
PCV13|14<br />
PCV13|9V<br />
PCV13|4<br />
PCV13|18C<br />
PCV13|1<br />
PCV13|7<br />
PCV13|3<br />
PCV13|6A<br />
PCV13|19A<br />
Existing serotypes|19F<br />
Existing serotypes|23F<br />
Existing serotypes|6B<br />
Existing serotypes|14<br />
Existing serotypes|9V<br />
Existing serotypes|4<br />
Existing serotypes|18C<br />
Existing serotypes|1<br />
Existing serotypes|7<br />
Existing serotypes|6A<br />
Existing serotypes|19A<br />
Existing serotypes|3<br />
Existing serotypes|8<br />
Existing serotypes|9N<br />
Existing serotypes|10<br />
Existing serotypes|11<br />
Existing serotypes|12<br />
Existing serotypes|15<br />
Existing serotypes|16<br />
Existing serotypes|20<br />
Existing serotypes|22<br />
Existing serotypes|23A<br />
Existing serotypes|33<br />
Existing serotypes|35<br />
Existing serotypes|38<br />
Existing serotypes|6C<br />
Existing serotypes|Oth<br />
</t2b><br />
}}<br />
<br />
=== Initiate functions ===<br />
<br />
<rcode name="initiate" label="Initiate functions" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
#S1.4. The R-functions<br />
###############################################################################<br />
##<br />
## R code for the core methods introduced in<br />
## Markku Nurhonen and Kari Auranen:<br />
## "Optimal serotype compositions for pneumococcal conjugate<br />
## vaccination under serotype replacement",<br />
## PLoS Computational Biology, 2014.<br />
##<br />
###############################################################################<br />
## List of arguments common to most functions:<br />
##<br />
## IPD = matrix of IPD incidences by age class (columns) and serotype (rows)<br />
## Car = corresponding matrix of carriage incidences<br />
## VT_rows = vector of the row numbers in matrices IPD and Car<br />
## corresponding to vaccine types (VT_rows=0 for no vaccination)<br />
## p = proportion of lost VT carriage which is replaced by NVT carriage<br />
## q = proportion of VT carriage lost either due to elimination or replacement<br />
##<br />
## This code includes 4 functions:<br />
## Vaccination, NextVT, OptimalSequence and OptimalVacc.<br />
##<br />
<br />
Vaccination<-function(IPD,Car,VT_rows,p,q) {<br />
##<br />
## Result:<br />
## A list of 2 matrices: IPD and carriage incidences<br />
## after vaccination (corresponding to matrices IPD and Car).<br />
## [Markku Nurhonen 2013]<br />
##<br />
if (VT_rows[1]>0) {<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
# Post vaccination carriage incidences<br />
Car_Total<-t(matrix(apply(Car,2,sum),dim(Car)[2],dim(Car)[1]))<br />
Car2<-Car; Car2[VT_rows,]<-0<br />
Car_NVT<-t(matrix(apply(Car2,2,sum),dim(Car2)[2],dim(Car2)[1]))<br />
Car_VT<-Car_Total-Car_NVT<br />
CarNew<-q*(1+p*Car_VT/Car_NVT)*Car2+(1-q)*Car<br />
# Post vaccination IPD incidences<br />
NVT_rows<-seq(dim(IPD)[1])[-1*VT_rows]<br />
# CCR=Case-to-carrier ratios<br />
CCR<-IPD/Car ; IPDNew<-0*IPD<br />
# Apply the equation appearing above<br />
# equation (1) in text for each serotype.<br />
# First term applies to NVTs.<br />
IPDNew[VT_rows,]<-(1-q)*IPD[VT_rows,]<br />
# Second term applies to NVTs.<br />
IPDNew[NVT_rows,]<-((Car_NVT+p*q*Car_VT)*(Car/Car_NVT)*CCR)[NVT_rows,]<br />
}<br />
else {<br />
IPDNew<-IPD; CarNew<-Car<br />
}<br />
list(IPDNew,CarNew) <br />
}<br />
<br />
NextVT<-function(IPD,Car,VT_rows,p) {<br />
##<br />
## Result:<br />
## A vector of decreases in IPD due to adding a serotype<br />
## to the vaccine. If VT_rows=0, initially no vaccination.<br />
## For row indexes incuded in VT_rows, the result is 0.<br />
## [Markku Nurhonen 2013]<br />
##<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
<br />
## VaccMat = IPD and Car matrices after vaccination<br />
VaccMat<-Vaccination(IPD,Car,VT_rows,p,1)<br />
IPD<-VaccMat[[1]]; Car<-VaccMat[[2]]<br />
<br />
## Total_IPD,Total_Car = Matrices corresponding to<br />
## overall IPD and carriage in each age class.<br />
Total_IPD<-t(matrix(apply(IPD,2,sum),dim(IPD)[2],dim(IPD)[1]))<br />
Total_Car<-t(matrix(apply(Car,2,sum),dim(Car)[2],dim(Car)[1]))<br />
<br />
## Effect = decrease in IPD when one serotype is added to the vaccine.<br />
## See equation (3) in text.<br />
Effect<-(Total_IPD-IPD)*((IPD/(Total_IPD-IPD))-(p*Car/(Total_Car-Car)))<br />
<br />
## Special case when only one NVT remains.<br />
IPD_nonzero<-which(apply(IPD,1,sum)!=0)<br />
if (length(IPD_nonzero)==1) {Effect[IPD_nonzero,]<-IPD[IPD_nonzero,]}<br />
<br />
## Result is obtained after summation over age classes.<br />
apply(Effect,1,sum) <br />
}<br />
<br />
OptimalSequence<-function(IPD,Car,VT_rows,Excluded_rows,p,HowmanyAdded) {<br />
##<br />
## Starting from VTs indicated by the vector VT_rows<br />
## (VT_rows=0, for no vaccination) sequentially add new VTs<br />
## to the vaccine composition s.t. at each step the optimal<br />
## serotype (corresponding to largest decrease in IPD) is added.<br />
##<br />
## Excluded_rows = Vector of indexes of the rows in matrices<br />
## IPD and Car corresponding to serotypes that are not to<br />
## be included in a vaccine composition, e.g. a row<br />
## corresponding to a group of serotypes labelled "Other".<br />
## Enter Excluded_rows=0 for no excluded serotypes.<br />
## HowmanyAdded = number of VTs to be added.<br />
##<br />
## Result:<br />
## Matrix of dimension 2*HowmanyAdded with 1st row indicating<br />
## the row numbers of added serotypes in the order they appear<br />
## in the sequence. The 2nd row lists the decreases in IPD<br />
## due to addition of each type. [Markku Nurhonen 2013]<br />
##<br />
IPD<-as.matrix(IPD); Car<-as.matrix(Car)<br />
## First check the maximum possible number of added VTs.<br />
VT_howmany<-length(VT_rows)<br />
if (VT_rows[1]==0) {VT_howmany<-0}<br />
Excluded_howmany<-length(Excluded_rows)<br />
if (Excluded_rows[1]==0) {Excluded_howmany<-0}<br />
HowmanyAdded<-min(HowmanyAdded,dim(IPD)[1]-(VT_howmany+Excluded_howmany))<br />
BestVTs<-BestEffects<-rep(0,HowmanyAdded)<br />
## Sequential procedure: at each step find the best additional VT.<br />
for (i in 1:HowmanyAdded) {<br />
## Effects = Decrease in IPD after addition of each serotype<br />
Effects<-NextVT(IPD,Car,VT_rows,p)<br />
## Set Effects for VTs and excluded types equal to small values<br />
## so that none of these will be selected as the next VT.<br />
minvalue<- -2*max(abs(Effects))<br />
if (Excluded_howmany>0) {Effects[Excluded_rows]<-minvalue}<br />
if (VT_rows[1]>0) {Effects[VT_rows]<-minvalue}<br />
## BestVTs[i] = Index of serotype with maximum decrease in IPD.<br />
BestVTs[i]<-order(-1*Effects)[1]<br />
## BestEffects[i] = Decrese in IPD due to addition of BestVTs[i]<br />
## to the vaccine.<br />
BestEffects[i]<-Effects[BestVTs[i]]<br />
VT_rows<-c(VT_rows,BestVTs[i])<br />
if (VT_rows[1]==0) {VT_rows<-VT_rows[-1]}<br />
VaccMat<-Vaccination(IPD,Car,VT_rows,p,1)<br />
IPD<-VaccMat[[1]]; Car<-VaccMat[[2]] <br />
}<br />
t(matrix(c(BestVTs,BestEffects),HowmanyAdded,2)) <br />
}<br />
<br />
OptimalVacc<-function(IPD,Car,VT_rows,p,q,HowmanyAdded) {<br />
##<br />
## Result:<br />
## A list of 3 elements: (1) Row numbers of serotypes in the optimal<br />
## vaccine composition (2)-(3) IPD and carriage incidences<br />
## by serotype and age class corresponding to the optimal<br />
## vaccine formed using the sequential procedure in the<br />
## function OptimalSequence. [Markku Nurhonen 2013]<br />
##<br />
Additional_VTs<-OptimalSequence(IPD,Car,VT_rows,p,HowmanyAdded)[1,]<br />
All_VTs<-c(VT_rows,Additional_VTs)<br />
if (All_VTs[1]==0) All_VTs<-All_VTs[-1]<br />
VaccMat<-Vaccination(IPD,Car,All_VTs,p,q)<br />
list(All_VTs,VaccMat[[1]],VaccMat[[2]]) <br />
}<br />
<br />
VacCar <- Ovariable("VacCar",<br />
dependencies = data.frame(Name = c(<br />
"IPD", # incidence of pneumococcus disease<br />
"Car", # number of carriers of pneumococcus<br />
"servac", # ovariable of serotypes in vaccine (1 for serotypes in a vaccine, otherwise result is 0)<br />
"p", # proportion of eliminated VT carriage that is replaced by NVT carriage<br />
"q" # proportion of of VT carriage eliminated by vaccine<br />
)), <br />
formula = function(...) {<br />
## Result:<br />
## An ovariable of carriage incidences<br />
## after vaccination (corresponding to Car).<br />
## [Markku Nurhonen 2013, Jouni Tuomisto 2014]<br />
# Post vaccination carriage incidences<br />
<br />
# Sum over serotypes and drop extra columns<br />
#Car_Total<- unkeep(oapply(Car, cols = "Serotype", FUN = sum) * 1, prevresults = TRUE)<br />
# Car2 is a temporary ovariable with NVT carriers only<br />
#Car2 <- unkeep(Car * (1 - servac), prevresults = TRUE) # Take only NVT carriers<br />
<br />
#Car_NVT <- oapply(Car2, cols = "Serotype", FUN = sum) # Carriers of serotypes not in vaccine (NVT)<br />
#Car_VT <- Car_Total - Car_NVT # Carriers of vaccine serotypes<br />
<br />
#CarNew <- q * (1 + p * Car_VT / Car_NVT) * Car2 + (1 - q) * Car<br />
<br />
eliminated <- q * servac * Car<br />
eliminated <- unkeep(eliminated, prevresults = TRUE)<br />
<br />
replaced <- oapply(eliminated, NULL, sum, "Serotype") * p<br />
# Distribute increase evenly among non-vaccine serotypes<br />
replaced <- unkeep(1 - servac, prevresults = TRUE) / <br />
oapply(unkeep(1 - servac, prevresults = TRUE), NULL, sum, "Serotype") * <br />
replaced<br />
<br />
replaced <- unkeep(replaced, prevresults = TRUE)<br />
<br />
CarNew <- Car - eliminated + replaced<br />
return(CarNew)<br />
}<br />
)<br />
<br />
VacIPD <- Ovariable("VacIPD",<br />
dependencies = data.frame(Name = c(<br />
"IPD", # incidence of pneumococcus disease<br />
"Car", # number of carriers of pneumococcus<br />
"servac", # ovariable of serotypes in vaccine (1 for serotypes in a vaccine, otherwise result is 0)<br />
"p", # proportion of eliminated VT carriage that is replaced by NVT carriage<br />
"q" # proportion of of VT carriage eliminated by vaccine<br />
#"VacCar" # proportional serotype carriage after vaccination<br />
)), <br />
formula = function(...) {<br />
## Result:<br />
## An ovariable of IPD incidence<br />
## after vaccination (corresponding to ovariable IPD).<br />
## [Markku Nurhonen 2013, Jouni Tuomisto 2014]<br />
<br />
# Post vaccination carriage incidences (same code as in VacCar)<br />
<br />
#Car_Total <- unkeep(oapply(Car, cols = "Serotype", FUN = sum) * 1, prevresults = TRUE) # Sums over serotypes<br />
#Car2 <- unkeep(Car * (1 - servac), prevresults = TRUE)<br />
<br />
#Car_NVT <- oapply(Car2, cols = "Serotype", FUN = sum) # Carriers of serotypes not in vaccine (NVT)<br />
#Car_VT <- Car_Total - Car_NVT # Carriers of vaccine serotypes<br />
#CarNew <- q * (1 + p * Car_VT / Car_NVT) * Car2 + (1 - q) * Car<br />
<br />
# Post vaccination IPD incidences<br />
# CCR=Case-to-carrier ratios<br />
#CCR <- IPD / Car<br />
<br />
# Apply the equation appearing above<br />
# equation (1) in text for each serotype.<br />
# First term applies to VTs.<br />
#IPDNewVT <- (1 - q) * IPD * servac<br />
<br />
# Second term applies to NVTs.<br />
#IPDNewNVT <- (Car_NVT + p * q * Car_VT) * (Car / Car_NVT) * CCR * (1 - servac)<br />
<br />
#IPDNew <- IPDNewVT + IPDNewNVT<br />
<br />
#IPDNew <- IPD * unkeep(VacCar, prevresults = TRUE) / Car<br />
#IPDNew <- IPD * exp(unkeep(log(VacCar), prevresults = TRUE) - unkeep(log(Car), prevresults = TRUE))<br />
<br />
eliminated <- q * servac * Car<br />
eliminated <- unkeep(eliminated, prevresults = TRUE)<br />
<br />
replaced <- oapply(eliminated, NULL, sum, "Serotype") * p<br />
# Distribute increase evenly among non-vaccine serotypes<br />
#replaced <- unkeep(1 - servac, prevresults = TRUE) / <br />
# oapply(1 - servac, NULL, sum, "Serotype") * <br />
# replaced<br />
<br />
replaced <- unkeep(replaced, prevresults = TRUE)<br />
<br />
IPDNew <- ((1 - q * servac) + (1 - servac) * replaced / oapply((1 - servac) * Car, NULL, sum, "Serotype")) * IPD <br />
#oapply(IPDNew, IPDNew@output$Vaccine, sum)<br />
<br />
return(IPDNew) <br />
}<br />
)<br />
<br />
objects.store(Vaccination, NextVT, OptimalSequence, OptimalVacc, VacCar, VacIPD)<br />
<br />
cat("the functions Vaccination, NextVT, OptimalSequence, OptimalVacc and the ovariables VacCar, VacIPD are now saved. \n")<br />
<br />
</rcode><br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33288Economic evaluation2014-08-24T11:09:08Z<p>Mnud: data summary tables added</p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
=== Computation ===<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the epidemiological model to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. <br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:debug_plot|description:Debug plots|type:checkbox|options:1;Show all|default:1|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
#oprint(VacIPD)<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
#QALYpercase <- Ovariable("QALYpc", ddata = "Op_en6358.qalys_lost") # [[Economic evaluation]] QALYs per case<br />
<br />
#costpercase <- Ovariable("costpc", ddata = "Op_en6358.costs_incurred") # [[Economic evaluation]] QALYs per case<br />
<br />
#QALY <- VacIPD * QALYpercase <br />
<br />
#cost <- VacIPD * costpercase + vacprice<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
#oprint(Total_costs)<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
#costind <- "Vaccine"<br />
#if("Iter" %in% colnames(Total_costs@output)) costind <- c(costind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
#costsum <- oapply(Total_costs, INDEX = Total_costs@output[costind], FUN = sum)<br />
costsum <- Total_costs<br />
<br />
#oprint(costsum)<br />
#oprint(qalysum)<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
<br />
if (1==2) {<br />
oprint(<br />
qalysum, <br />
include.rownames = FALSE, <br />
caption = "QALYs lost due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
health_care_costs, <br />
include.rownames = FALSE, <br />
caption = "Health care costs due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
costsum,<br />
include.rownames = FALSE, <br />
caption = "Total costs (health care + vaccination)", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
ICER, <br />
include.rownames = FALSE, <br />
caption = "Cost-effectiveness of vaccination choices", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
sumtable(), <br />
include.rownames = FALSE, <br />
caption = "Summary table", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
if (!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
if (!is.null(debug_plot)) plot3<br />
if (!is.null(debug_plot)) plot2<br />
if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty, for debugging purposes<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
if (1==2) {<br />
oprint(<br />
oapply(VacIPD, VacIPD@output["Vaccine"], sum), <br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
<br />
vaccres<-matrix(result(VacIPD),101,3)[,c(3,1,2)]<br />
ipdsums<-apply(vaccres,2,sum)<br />
ipdtable<-data.frame(Vaccination_____=c("No vaccination ","PCV10 ","PCV13 "),N_of_IPD_cases____=round(ipdsums))<br />
<br />
oprint(ipdtable,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
) <br />
<br />
<br />
<br />
##############################<br />
## print healt care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine__ = qorder,<br />
Medical_costs__ = 0.01*round((result(health_care_costs)/1E4)[match(qorder,health_care_costs@output$Vaccine)]),<br />
Vaccine_programme_cost__ = 0.01*round(result(vacprice)/1E4),<br />
Health_care_costs__ = 0.01*round((result(costsum)/1E4)[match(qorder,costsum@output$Vaccine)])<br />
)<br />
oprint(<br />
sum_table1A,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top"<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(tekstia, include.rownames = FALSE, include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top")<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained__ = round(QALYs_gained),<br />
Incremental_effect__ = round(QALYs_incremental),<br />
Health_care_costs__ = 0.01*round(Cost_total/1E4),<br />
Incremental_cost__ = 0.01*round(Cost_incremental/1E4),<br />
ICER__ = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top"<br />
)<br />
</rcode><br />
<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Rationale == <br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological_modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER):<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. <br />
<br />
<br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study ([http://www.biomedcentral.com/1471-2334/8/96 Klemets et. al (2008)]). The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Sensitivity ===<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
<br />
<br />
=== Data ===<br />
Summary tables of the data applied in calcuating the economic model. <br />
<br />
<br><br />
1. IPD-menin = meningitis, number of cases per year<br />
2. IPD-bact = bacteremia, number of cases per year<br />
3. QALY_menin = QALY losses due to meningitis (in years, *)<br />
4. QALY_bact = QALY losses due to bacteremia (in years, *)<br />
5. Life_y_lost = Life years lost due to IPD (mengitis or bacteremia, *)<br />
6. Cost_ menin = Medical costs attributed to meningitis (in euros *)<br />
7. Cost_ bact = Medical costs attributed to bacteremia (in euros *)<br />
(*) a discount rate of 3%/year was applied in all calculations<br />
<br />
{|{{prettytable}}<br />
|+'''Estimated medical costs and years lost per year in Finland without vaccination'''<br />
|---<br />
|'''Age group'''||'''IPD_menin'''||'''IPD_bact'''||'''QALY_menin'''||'''QALY_bact'''||'''Life_y_lost'''||'''Cost_menin'''||'''Cost_bact'''<br />
|---<br />
|'''0-4y'''||3.70||95.3||0.83||0.75||43.64||81 591||189 444<br />
|---<br />
|'''5-64y'''||17.78||367.5||2.89||2.90||895.01||470 949||3 308 515<br />
|---<br />
|'''65+y'''||5.85||296.1||0.51||2.34||555.60||125 916||2 020 437<br />
|---<br />
|}<br />
{|{{prettytable}}<br />
|+'''Estimated medical costs and years lost due to a single bacteremia or meningitis episode''' <br />
|---<br />
| '''Age group'''||'''QALY_menin'''||'''QALY_bact'''||'''Life_y_lost'''||'''Cost_menin'''||'''Cost_bact'''<br />
|---<br />
|'''0-4y'''|| 0.223||0.0079||31.0||22 070||1 986<br />
|---<br />
|'''5-64y'''|| 0.162||0.0079||20.6||26 488||9 000<br />
|---<br />
|'''65+y''' || 0.086||0.0079||9.3||21 529||6 823<br />
|---<br />
|}<br />
<br />
<br><br />
<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33287Economic evaluation2014-08-24T10:13:31Z<p>Mnud: Klemets viite muutettu</p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
=== Computation ===<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the epidemiological model to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. <br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:debug_plot|description:Debug plots|type:checkbox|options:1;Show all|default:1|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
#oprint(VacIPD)<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
#QALYpercase <- Ovariable("QALYpc", ddata = "Op_en6358.qalys_lost") # [[Economic evaluation]] QALYs per case<br />
<br />
#costpercase <- Ovariable("costpc", ddata = "Op_en6358.costs_incurred") # [[Economic evaluation]] QALYs per case<br />
<br />
#QALY <- VacIPD * QALYpercase <br />
<br />
#cost <- VacIPD * costpercase + vacprice<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
#oprint(Total_costs)<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
#costind <- "Vaccine"<br />
#if("Iter" %in% colnames(Total_costs@output)) costind <- c(costind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
#costsum <- oapply(Total_costs, INDEX = Total_costs@output[costind], FUN = sum)<br />
costsum <- Total_costs<br />
<br />
#oprint(costsum)<br />
#oprint(qalysum)<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
<br />
if (1==2) {<br />
oprint(<br />
qalysum, <br />
include.rownames = FALSE, <br />
caption = "QALYs lost due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
health_care_costs, <br />
include.rownames = FALSE, <br />
caption = "Health care costs due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
costsum,<br />
include.rownames = FALSE, <br />
caption = "Total costs (health care + vaccination)", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
ICER, <br />
include.rownames = FALSE, <br />
caption = "Cost-effectiveness of vaccination choices", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
sumtable(), <br />
include.rownames = FALSE, <br />
caption = "Summary table", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
if (!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
if (!is.null(debug_plot)) plot3<br />
if (!is.null(debug_plot)) plot2<br />
if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty, for debugging purposes<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
if (1==2) {<br />
oprint(<br />
oapply(VacIPD, VacIPD@output["Vaccine"], sum), <br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
<br />
vaccres<-matrix(result(VacIPD),101,3)[,c(3,1,2)]<br />
ipdsums<-apply(vaccres,2,sum)<br />
ipdtable<-data.frame(Vaccination_____=c("No vaccination ","PCV10 ","PCV13 "),N_of_IPD_cases____=round(ipdsums))<br />
<br />
oprint(ipdtable,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
) <br />
<br />
<br />
<br />
##############################<br />
## print healt care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine__ = qorder,<br />
Medical_costs__ = 0.01*round((result(health_care_costs)/1E4)[match(qorder,health_care_costs@output$Vaccine)]),<br />
Vaccine_programme_cost__ = 0.01*round(result(vacprice)/1E4),<br />
Health_care_costs__ = 0.01*round((result(costsum)/1E4)[match(qorder,costsum@output$Vaccine)])<br />
)<br />
oprint(<br />
sum_table1A,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top"<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(tekstia, include.rownames = FALSE, include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top")<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained__ = round(QALYs_gained),<br />
Incremental_effect__ = round(QALYs_incremental),<br />
Health_care_costs__ = 0.01*round(Cost_total/1E4),<br />
Incremental_cost__ = 0.01*round(Cost_incremental/1E4),<br />
ICER__ = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top"<br />
)<br />
</rcode><br />
<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Rationale == <br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological_modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER):<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. <br />
<br />
<br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study ([http://www.biomedcentral.com/1471-2334/8/96 Klemets et. al (2008)]). The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Sensitivity ===<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
<br />
<br />
=== Data ===<br />
<br />
The data table to appear.<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Pneumococcal_vaccine_products&diff=33284Pneumococcal vaccine products2014-08-23T09:07:53Z<p>Mnud: Added references (EMA page)</p>
<hr />
<div>{{variable}}<br />
{{progression class|progression=Full draft}}<br />
<br />
== Question ==<br />
<br />
What information should users have on different pneumococcal vaccine products (Prevenar 13 and Synflorix) before making the decision?<br />
<br />
== Answer ==<br />
<br />
{| class="wikitable"<br />
|-<br />
! !! Prevenar 13 !! Synflorix<br />
|-<br />
| Intended age group || 6 weeks - 17 years || 6 weeks - 5 years<br />
|-<br />
| Serotypes || 1 <br>3 <br>4 <br>5 <br>6A <br>6B <br>7F <br>9V <br>14 <br>18C <br>19A <br>19F <br>23F || 1 <br>4 <br>5 <br>6B <br>7F <br>9V <br>14 <br>18C <br>19F <br>23F<br />
|-<br />
| Research done on age groups || 1 266 children, 2-15 months <br> 598 children, 5-17 years <br> 835 adults, 50-64 years <br> 938 adults, over 70 years <br> 900 adults, 18-49 years || 30 000 children, under 7 months <br> 24 000 children, 6-16 weeks <br> 5 000 children, 3 months <br> 1 650 children, 6-12 weeks <br> children, 2-5 years<br />
|}<br />
<br />
== Rationale == <br />
<br />
Prevenar 13 and Synflorix are vaccines. More precisely, they are a suspension for injection that contains parts from different types of <br />
the bacterium Streptococcus pneumoniae (S. pneumoniae). They are used to protect children against invasive disease, <br />
pneumonia (infection of the lungs) and acute otitis media (infection of the middle ear) caused by <br />
S. pneumoniae.<br />
<br />
Adults should receive one single dose of Prevenar 13 into the shoulder muscle. In children, the vaccine is given by injection into the thigh muscle in children below two years of age, <br />
and into the shoulder muscle in children over two years of age.<br />
<br />
=== How do vaccines work? ===<br />
<br />
Vaccines work by ‘teaching’ the immune system (the body’s natural defences) how to defend itself <br />
against a disease. When a person is given the vaccine, the immune system recognises the parts of the <br />
bacterium contained in the vaccine as ‘foreign’ and makes antibodies against them. The immune <br />
system will then be able to produce antibodies more quickly when it is exposed to the bacterium. This <br />
helps to protect against the disease.<br />
<br />
Prevenar 13 and Synflorix contain small amounts of polysaccharides (a type of sugar) extracted from the ‘capsule’ <br />
that surrounds the S. pneumoniae bacterium. These polysaccharides have been purified, then <br />
‘conjugated’ (attached) to a carrier to help them to be recognised by the immune system. The vaccine <br />
is also ‘adsorbed’ (fixed) onto an aluminium compound to enhance the immune response. <br />
<br />
=== Research ===<br />
<br />
==== Prevenar 13 ====<br />
<br />
The ability of Prevenar 13 to trigger the production of antibodies (immunogenicity) in children was <br />
assessed in two main studies involving 1,266 healthy children who were vaccinated between the ages <br />
of two and 15 months and in a third study involving 598 children aged between five and 17 years old <br />
who had previously been vaccinated with Prevenar or who had never been vaccinated for invasive <br />
pneumococcal disease. Prevenar 13 was compared with Prevenar. The studies compared the immune <br />
response for Prevenar 13 with that for Prevenar against the seven polysaccharides that they share in <br />
common. In the first two studies they were compared directly, and in the third study the results for<br />
Prevenar 13 were compared to those obtained for Prevenar in a previous study. The immune response <br />
to the additional six polysaccharides in Prevenar 13 was compared with the lowest immune response to <br />
any of the polysaccharides in Prevenar. Additional studies in children looked at the effects of giving <br />
booster vaccinations, switching from Prevenar to Prevenar 13 and using Prevenar 13 alongside other <br />
vaccines routinely given to children. <br />
<br />
Prevenar 13 was also investigated in three main studies in adults. The first study involved 835 adults <br />
aged 50 to 64 years who had not previously been vaccinated against invasive disease caused by <br />
S. pneumoniae. The second study involved 938 adults aged 70 years or older who had already been <br />
vaccinated against invasive disease caused by S. pneumoniae at least five years earlier. In both <br />
studies, Prevenar 13 was compared with a similar vaccine containing the polysaccharides from 23 <br />
different types of S. pneumoniae (23-valent polysaccharide vaccine). The studies compared the <br />
immune responses one month after vaccination with the two vaccines. A third study, which involved <br />
900 adults aged 18 to 49, compared the immune response to Prevenar 13 with the response in adults <br />
aged 60 to 64.<br />
<br />
==== Synflorix ====<br />
<br />
Synflorix was evaluated in a large study involving over 30,000 infants aged below 7 months of age <br />
who were given either Synflorix or a comparator vaccine which was not active against S. pneumoniae. <br />
The children were followed up for an average of around two years to see how effective Synflorix was in <br />
preventing invasive disease. <br />
<br />
Synflorix was also investigated in a large study involving around 24,000 children aged between 6 and <br />
16 weeks that focussed mainly on the vaccine’s benefit in preventing community acquired pneumonia. <br />
The children in this study were given either Synflorix or a comparator vaccine which was not active <br />
against S. pneumoniae and were followed up for an average of 30 months. <br />
<br />
Another main study was carried out to determine whether Synflorix would prevent acute otitis media. <br />
The study involved almost 5,000 infants aged three months and compared an investigational vaccine <br />
that contains the same polysaccharides as Synflorix with another vaccine that is not active against<br />
S. pneumoniae infection (in this case, a vaccine against hepatitis A virus). The children were followed <br />
up until the end of their second year of life. <br />
<br />
The ability of Synflorix to trigger the production of antibodies (immunogenicity) was assessed in one <br />
main study involving 1,650 healthy infants aged between six and 12 weeks. Synflorix was compared <br />
with another vaccine that is authorised in the European Union (EU) to protect children against <br />
S. pneumoniae infection, and which contains seven of the 10 polysaccharides included in Synflorix. The <br />
study compared the immunogenicity of the two vaccines against the different polysaccharides. <br />
<br />
Additional studies looked at the effects of booster vaccinations and vaccinations in older infants and <br />
children. In particular, two clinical studies in children aged two to five years investigated the ability of <br />
Synflorix to produce antibodies in this age group compared with other age groups. The children <br />
received one dose of Synflorix in the first study and two doses in the second study. <br />
<br />
=== Benefits ===<br />
<br />
==== Prevenar 13 ====<br />
<br />
In children under five years of age, Prevenar 13 produced a response that was at least as good as <br />
Prevenar for six of the seven S. pneumoniae polysaccharides they share in common in the first main <br />
study, and for five of the seven in the second. Where the response to Prevenar 13 was lower than the <br />
comparator, the differences were considered to be small. All six of the additional polysaccharides in <br />
Prevenar 13 produced a response at least as good as the lowest response seen with Prevenar in the <br />
first main study. This was true for five of the six additional polysaccharides in the second study. <br />
<br />
In children aged between five and 17 years old, Prevenar 13 produced a response that was at least as <br />
good as Prevenar for all seven S. pneumoniae polysaccharides they share in common. All six of the <br />
additional polysaccharides in Prevenar 13 produced a response that was similar to the response seen <br />
with Prevenar.<br />
<br />
The additional studies showed that Prevenar 13 led to an increase in antibody production following <br />
booster vaccinations and supported a switch to Prevenar 13 in children who had started vaccination <br />
with Prevenar. Prevenar 13 was not shown to affect the immunogenicity of other vaccines routinely <br />
given to children. <br />
<br />
In adults aged 50 and older, in both the main studies Prevenar 13 produced an immune response that <br />
was at least as good as the 23-valent polysaccharide vaccine for all 12 of the S. pneumoniae <br />
polysaccharides they share in common, and for several of these serotypes the immune response was <br />
better with Prevenar 13. Adults aged 18 to 49 had an immune response with Prevenar 13 which was as <br />
good as the response in adults aged 60 to 64. <br />
<br />
==== Synflorix ====<br />
<br />
In the invasive disease study, Synflorix was shown to be effective in protecting against invasive <br />
disease: no cases were seen among the 10,000 children given three doses of Synflorix and a booster, <br />
one case was among the 10,000 children given two doses of Synflorix and a booster and 12 cases were <br />
seen in 10,000 children given the comparator vaccine. <br />
<br />
Synflorix was also shown to reduce the occurrence of pneumonia. In the large study that focused <br />
mainly on pneumonia, the percentage of children who had bacterial pneumonia was 2.3% (240 out of <br />
over 10,000) among those given Synflorix compared with 3% (304 out of over 10,000) among those <br />
given the comparator. <br />
<br />
In the study looking at otitis media, the investigational vaccine containing the same polysaccharides as <br />
Synflorix was more effective than the comparator in preventing otitis media. The occurrence of the first <br />
episode of acute otitis media caused by S. pneumoniae was approximately halved among children who <br />
were given the vaccine compared with those given the comparator. Based on a comparison of the <br />
immune response of Synflorix with the vaccine used in the study, it is expected that Synflorix would <br />
provide similar protection against acute otitis media caused by S. pneumoniae. <br />
<br />
In the immunogenicity study, Synflorix produced a similar response to the comparator vaccine for the <br />
majority of the S. pneumoniae polysaccharides they share in common. Synflorix was as effective as <br />
the comparator in triggering the production of antibodies against five of the polysaccharides that the <br />
two vaccines shared in common (4, 9V, 14, 18C and 19F), but it was less effective than the <br />
comparator for two (6B and 23F). For the three additional polysaccharides (1, 5, 7F), Synflorix was <br />
effective in triggering the production of antibodies. <br />
<br />
The additional studies in infants and older children showed that although Synflorix produced a lower <br />
antibody response than the comparator vaccine, it fulfilled pre-defined criteria and was considered <br />
acceptable in this group. Both Synflorix and the comparator showed an increase in antibody production <br />
following booster vaccinations. <br />
<br />
When Synflorix was tested in two to five years olds, the response to Synflorix was similar to the <br />
younger age group, with better results in children who received two doses. <br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== references ==<br />
<br />
<references/><br />
<br />
* [http://www.ema.europa.eu/ema/index.jsp?curl=pages/medicines/human/medicines/000973/human_med_001071.jsp&mid=WC0b01ac058001d124 Summary of the European public assessment report for Synflorix on the European Medicines Agency webpage.]<br />
* [http://www.ema.europa.eu/ema/index.jsp?curl=pages/medicines/human/medicines/001104/human_med_001220.jsp&mid=WC0b01ac058001d124 Summary of the European public assessment report for Prevenar13 on the European Medicines Agency webpage.]</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33283Economic evaluation2014-08-23T00:21:51Z<p>Mnud: </p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
=== Computation ===<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the epidemiological model to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. <br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:20|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:debug_plot|description:Debug plots|type:checkbox|options:1;Show all|default:1|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
#oprint(VacIPD)<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
#QALYpercase <- Ovariable("QALYpc", ddata = "Op_en6358.qalys_lost") # [[Economic evaluation]] QALYs per case<br />
<br />
#costpercase <- Ovariable("costpc", ddata = "Op_en6358.costs_incurred") # [[Economic evaluation]] QALYs per case<br />
<br />
#QALY <- VacIPD * QALYpercase <br />
<br />
#cost <- VacIPD * costpercase + vacprice<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
#oprint(Total_costs)<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
#costind <- "Vaccine"<br />
#if("Iter" %in% colnames(Total_costs@output)) costind <- c(costind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
#costsum <- oapply(Total_costs, INDEX = Total_costs@output[costind], FUN = sum)<br />
costsum <- Total_costs<br />
<br />
#oprint(costsum)<br />
#oprint(qalysum)<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
<br />
if (1==2) {<br />
oprint(<br />
qalysum, <br />
include.rownames = FALSE, <br />
caption = "QALYs lost due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
health_care_costs, <br />
include.rownames = FALSE, <br />
caption = "Health care costs due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
costsum,<br />
include.rownames = FALSE, <br />
caption = "Total costs (health care + vaccination)", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
ICER, <br />
include.rownames = FALSE, <br />
caption = "Cost-effectiveness of vaccination choices", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
sumtable(), <br />
include.rownames = FALSE, <br />
caption = "Summary table", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
if (!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
if (!is.null(debug_plot)) plot3<br />
if (!is.null(debug_plot)) plot2<br />
if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty, for debugging purposes<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
if (1==2) {<br />
oprint(<br />
oapply(VacIPD, VacIPD@output["Vaccine"], sum), <br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
<br />
vaccres<-matrix(result(VacIPD),101,3)[,c(3,1,2)]<br />
ipdsums<-apply(vaccres,2,sum)<br />
ipdtable<-data.frame(Vaccination_____=c("No vaccination ","PCV10 ","PCV13 "),N_of_IPD_cases____=round(ipdsums))<br />
<br />
oprint(ipdtable,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
) <br />
<br />
<br />
<br />
##############################<br />
## print healt care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine__ = qorder,<br />
Medical_costs__ = 0.01*round((result(health_care_costs)/1E4)[match(qorder,health_care_costs@output$Vaccine)]),<br />
Vaccine_programme_cost__ = 0.01*round(result(vacprice)/1E4),<br />
Health_care_costs__ = 0.01*round((result(costsum)/1E4)[match(qorder,costsum@output$Vaccine)])<br />
)<br />
oprint(<br />
sum_table1A,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top"<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(tekstia, include.rownames = FALSE, include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top")<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained__ = round(QALYs_gained),<br />
Incremental_effect__ = round(QALYs_incremental),<br />
Health_care_costs__ = 0.01*round(Cost_total/1E4),<br />
Incremental_cost__ = 0.01*round(Cost_incremental/1E4),<br />
ICER__ = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top"<br />
)<br />
</rcode><br />
<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Rationale == <br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological_modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER):<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. <br />
<br />
<br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study [Klemets P, Lyytikäinen O, Ruutu P, Ollgren J, Nuorti P. Incidence and outcome of invasive Streptococcus pneumonia infections, Finland, 1995 /2002. In: The 4th International Symposium on Pneumococci and Pneumococcal Diseases (ISPPD); 2004 May 9 /13 2004; Helsinki; 2004.]. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Sensitivity ===<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
<br />
<br />
=== Data ===<br />
<br />
The data table to appear.<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33282Economic evaluation2014-08-23T00:17:42Z<p>Mnud: </p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
=== Computation ===<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the epidemiological model to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. <br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:10|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:15|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:debug_plot|description:Debug plots|type:checkbox|options:1;Show all|default:1|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
#oprint(VacIPD)<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
#QALYpercase <- Ovariable("QALYpc", ddata = "Op_en6358.qalys_lost") # [[Economic evaluation]] QALYs per case<br />
<br />
#costpercase <- Ovariable("costpc", ddata = "Op_en6358.costs_incurred") # [[Economic evaluation]] QALYs per case<br />
<br />
#QALY <- VacIPD * QALYpercase <br />
<br />
#cost <- VacIPD * costpercase + vacprice<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
#oprint(Total_costs)<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
#costind <- "Vaccine"<br />
#if("Iter" %in% colnames(Total_costs@output)) costind <- c(costind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
#costsum <- oapply(Total_costs, INDEX = Total_costs@output[costind], FUN = sum)<br />
costsum <- Total_costs<br />
<br />
#oprint(costsum)<br />
#oprint(qalysum)<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
<br />
if (1==2) {<br />
oprint(<br />
qalysum, <br />
include.rownames = FALSE, <br />
caption = "QALYs lost due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
health_care_costs, <br />
include.rownames = FALSE, <br />
caption = "Health care costs due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
costsum,<br />
include.rownames = FALSE, <br />
caption = "Total costs (health care + vaccination)", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
ICER, <br />
include.rownames = FALSE, <br />
caption = "Cost-effectiveness of vaccination choices", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
sumtable(), <br />
include.rownames = FALSE, <br />
caption = "Summary table", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
if (!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
if (!is.null(debug_plot)) plot3<br />
if (!is.null(debug_plot)) plot2<br />
if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty, for debugging purposes<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
if (1==2) {<br />
oprint(<br />
oapply(VacIPD, VacIPD@output["Vaccine"], sum), <br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
<br />
vaccres<-matrix(result(VacIPD),101,3)[,c(3,1,2)]<br />
ipdsums<-apply(vaccres,2,sum)<br />
ipdtable<-data.frame(Vaccination_____=c("No vaccination ","PCV10 ","PCV13 "),N_of_IPD_cases____=round(ipdsums))<br />
<br />
oprint(ipdtable,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
) <br />
<br />
<br />
<br />
##############################<br />
## print healt care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine__ = qorder,<br />
Medical_costs__ = 0.01*round((result(health_care_costs)/1E4)[match(qorder,health_care_costs@output$Vaccine)]),<br />
Vaccine_programme_cost__ = 0.01*round(result(vacprice)/1E4),<br />
Health_care_costs__ = 0.01*round((result(costsum)/1E4)[match(qorder,costsum@output$Vaccine)])<br />
)<br />
oprint(<br />
sum_table1A,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top"<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(tekstia, include.rownames = FALSE, include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top")<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained__ = round(QALYs_gained),<br />
Incremental_effect__ = round(QALYs_incremental),<br />
Health_care_costs__ = 0.01*round(Cost_total/1E4),<br />
Incremental_cost__ = 0.01*round(Cost_incremental/1E4),<br />
ICER__ = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top"<br />
)<br />
</rcode><br />
<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Rationale == <br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological_modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER):<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. <br />
<br />
<br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study [Klemets P, Lyytikäinen O, Ruutu P, Ollgren J, Nuorti P. Incidence and outcome of invasive Streptococcus pneumonia infections, Finland, 1995 /2002. In: The 4th International Symposium on Pneumococci and Pneumococcal Diseases (ISPPD); 2004 May 9 /13 2004; Helsinki; 2004.]. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Sensitivity ===<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
<br />
<br />
=== Data ===<br />
<br />
The data table to appear.<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnudhttp://en.opasnet.org/en-opwiki/index.php?title=Economic_evaluation&diff=33281Economic evaluation2014-08-22T23:29:28Z<p>Mnud: </p>
<hr />
<div>{{method}}<br />
{{progression class|progression=Full draft}}<br />
<br />
[[op_fi:Taloudellinen_arviointi]]<br />
<br />
== Question == <br />
How to identify the most cost-effective pneumococcal conjugate vaccine to the national immunisation programme?<br />
<br />
* The health benefit (effectiveness) of the pneumococcal infant immunisation programme is assessed by the expected gain in Quality-Adjusted Life Years (QALYs), corresponding to the expected reduction in the annual number of invasive pneumococcal disease in the whole Finnish population. <br />
* The perspective of the analysis is that of the health care provider. <br />
* The analysis is based on incremental cost effectiveness<br />
<br />
<br />
== Answer ==<br />
<br />
The answer to the question is based on the concept of incremental costs. For example, if there are only two vaccines to be compared, the more effective (and more expensive vaccine) is said to be more cost-effective if the incremental cost effectiveness ratio (ICER), comparing the vaccine to the less effective vaccine, exceeds the ICER of the less effective vaccine as compared to the alternative 'no vaccination'. The principle in general is explained below (see 'Rationale').<br />
<br />
=== Computation ===<br />
<br />
The following programme can be used to calculate the incremental cost effectiveness ratios (ICERs) for <br />
two alternative vaccination programmes. The input required is: <br />
<br />
(a) the serotype compositions of the two vaccines to be compared (the defaults are PCV10 and PCV13), and <br />
<br />
(b) the prices per dose for the two vaccine products. <br />
<br />
The computation utilises the epidemiological model to predict the annual number of invasive pneumococcal disease (IPD) under both vaccination programmes and, for comparison, for the scenario 'no vaccination'. The summary table presents the ICERs. The vaccine programme with the lower ICER is identified as the more cost-effective of the two alternatives. <br />
<br />
<rcode embed=0 graphics=1 variables="<br />
name:vac|description:Please choose the vaccines to be compared:|type:checkbox|options:<br />
'PCV10';PCV-10;<br />
'PCV13';PCV-13|<br />
default:'PCV10';'PCV13'|<br />
category:Scenarios|<br />
name:price10|description:What is the price of a single PCV10 vaccination?|type:text|default:11.11|<br />
name:price13|description:What is the price of a single PCV13 vaccination?|type:text|default:12.22|<br />
name:custom_vac|description:Do you want to adjust PCV-10 or PCV-13 vaccine composition?|type:selection|options:<br />
FALSE;No;<br />
TRUE;Yes|<br />
default:FALSE|<br />
name:debug_plot|description:Debug plots|type:checkbox|options:1;Show all|default:1|<br />
name:vac_user10|description:Choose the serotypes for the PCV-10 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5'|<br />
category:User defined vaccine|<br />
category_conditions:custom_vac;TRUE|<br />
name:vac_user13|description:Choose the serotypes for the PCV-13 vaccine composition|type:checkbox|options:<br />
'1';1;<br />
'3';3;<br />
'4';4;<br />
'5';5;<br />
'6A';6A;<br />
'6B';6B;<br />
'6C';6C;<br />
'7';7F;<br />
'8';8;<br />
'9N';9N;<br />
'9V';9V;<br />
'10';10;<br />
'11';11;<br />
'12';12;<br />
'14';14;<br />
'15';15;<br />
'16';16;<br />
'18C';18C;<br />
'19A';19A;<br />
'19F';19F;<br />
'20';20;<br />
'22';22;<br />
'23A';23A;<br />
'23F';23F;<br />
'33';33;<br />
'35';35;<br />
'38';38;<br />
'Oth';Other|<br />
default:'19F';'23F';'6B';'14';'9V';'4';'18C';'1';'7';'5';'19A';'3';'6A'<br />
"><br />
<br />
#http://fi.opasnet.org/fi/Special:Opasnet_Base?id=op_fi4433.pneumokokki_vaestossa<br />
library(OpasnetUtils)<br />
library(ggplot2) <br />
<br />
openv.setN(100)<br />
<br />
if (length(vac) == 0) stop("Mitään skenaariota ei valittu")<br />
<br />
vac <- c("No_vaccination",vac)<br />
<br />
if(price10 == '') price10 <- 0<br />
if(price13 == '') price13 <- 0<br />
n_vac <- 1.8e5<br />
<br />
vacprice <- data.frame(<br />
Vaccine = c("No_vaccination", "PCV10", "PCV13"),<br />
Result = c(0, price10, price13)<br />
)<br />
<br />
vacprice <- EvalOutput(Ovariable("vacprice", data = vacprice[vacprice$Vaccine %in% vac , ])) * n_vac<br />
<br />
temp <- opbase.data("Op_en6353", subset = "serotypes_in_typical_pneumococcal_vaccines")<br />
temp$Obs <- NULL<br />
colnames(temp)[colnames(temp) == "Result"] <- "Serotype"<br />
<br />
serotypes <- temp[temp$Vaccine == "Existing serotypes" , "Serotype"]<br />
<br />
userserotypes <- temp[temp$Vaccine %in% vac , ]<br />
<br />
if(custom_vac) {<br />
userserotypes <- data.frame(<br />
Vaccine = c(rep("PCV10", length(vac_user10)), rep("PCV13", length(vac_user13))),<br />
Serotype = c(vac_user10, vac_user13)<br />
)<br />
}<br />
<br />
# Näyttää monimutkaiselta tuo servacin määrittely. Eikö voisi tehdä helpomminkin?<br />
# -- Pointti on siis että kullekin käyttäjän valitsemalle rokotteelle tehdään merkintä <br />
# sen sisältämistä serotyypeistä 1 sisältyy 0 ei. Näin skenaariot saadaan tehtyä yksinkertaisella<br />
# kertolaskulla (ovariable). Alla oleva koodi on täysin vektorisoitu ja kiertää siten kaksi <br />
# lyhyttä for looppia (R:n puolella), mikä on kieltämättä aika pieni voitto tässä tapauksessa... <br />
<br />
servac <- merge(<br />
data.frame(userserotypes, Result = 1), # Serotypes, either default or user-defined<br />
merge(data.frame(Vaccine = vac), data.frame(Serotype = serotypes)), # All combinations of vaccines and serotypes<br />
all.y = TRUE<br />
)<br />
servac$Result <- as.numeric(!is.na(servac$Result))<br />
servac <- Ovariable(<br />
"servac", <br />
data = servac<br />
)<br />
<br />
objects.latest("Op_en6358", code_name = "initiate") # [[:op_en:Economic evaluation]] ovariable ICER, function sumtable<br />
objects.latest("Op_en6353", code_name = "initiate") # [[:op_en:Epidemiological modelling]] ovariables VacCar, VacIPD<br />
objects.latest("Op_en6007", code_name = "answer") # [[OpasnetUtils/Drafts]]<br />
<br />
## Read the annual IPD and carriage incidence data.<br />
## The 0 entries in IPD and carriage data are replaced by small values.<br />
<br />
#IPD <- Ovariable("IPD", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
IPD <- Ovariable("IPD", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
<br />
IPD@data <- IPD@data[IPD@data$Observation == "Incidence" , colnames(IPD@data) != "Observation"]<br />
<br />
#Car <- Ovariable("Car", ddata = "Op_fi4305.pneumokokki_vaestossa")<br />
Car <- Ovariable("Car", ddata = "Op_fi4433.pneumokokki_vaestossa") # [[Markunkoesivu]]<br />
Car@data <- Car@data[Car@data$Observation == "Carrier" , colnames(Car@data) != "Observation"]<br />
<br />
<br />
p_user <- q_user <- adultcarriers <- 1<br />
<br />
p <- Ovariable("p", data = data.frame(Result = p_user))<br />
q <- EvalOutput(Ovariable("q", data = data.frame(Result = q_user))) <br />
# EvalOutput must be used because q is mentioned twice in the code and there will otherwise be a merge mismatch.<br />
<br />
## The true number of adult carriers may actually be larger than estimated. This adjusts for that.<br />
#Car <- Car * Ovariable("adjust", data = data.frame(Age = c("Under 5", "Over 5"), Result = c(1, adultcarriers)))<br />
<br />
#VacCar <- EvalOutput(VacCar)<br />
VacIPD <- EvalOutput(VacIPD)<br />
<br />
if (1==0) {<br />
cat("servac\n")<br />
oprint(summary(servac))<br />
<br />
<br />
cat("Number of carriers\n")<br />
oprint(summary(VacCar))<br />
cat("Incidence of invasive pneumococcal disease.\n")<br />
oprint(summary(VacIPD)) <br />
}<br />
<br />
#if("Iter" %in% colnames(VacCar@output)) N <- max(VacCar@output$Iter) else N <- 1<br />
if("Iter" %in% colnames(VacIPD@output)) N <- max(VacIPD@output$Iter) else N <- 1<br />
<br />
if (1==0) {ggplot(VacCar@output, aes(x = Serotype, weight = result(VacCar) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) + <br />
labs(title = "Carriers", y = "Number of carriers in Finland") }<br />
<br />
ggplot(VacIPD@output, aes(x = Serotype, weight = result(VacIPD) / N, fill = Vaccine)) + geom_bar(position = "dodge") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 1. Number of IPD cases per year, by serotype.", y = "Number of cases per year")<br />
<br />
VacIPD@output$Agegroup <- cut(<br />
as.numeric(levels(VacIPD@output$Age[VacIPD@output$Age])), <br />
breaks = c(0, 3, 5, 15, 65, 80, 101),<br />
include.lowest = TRUE<br />
)<br />
VacIPD@marginal <- c(VacIPD@marginal, FALSE)<br />
#oprint(VacIPD)<br />
ggplot(VacIPD@output, aes(x = Vaccine, weight = result(VacIPD) / N, fill = Agegroup)) + geom_bar(position = "stack") + theme_gray(base_size = 24) +<br />
labs(title = "Figure 2. Number of IPD cases per year, by age group.", y = "Number of cases per year")<br />
<br />
######################<br />
<br />
#QALYpercase <- Ovariable("QALYpc", ddata = "Op_en6358.qalys_lost") # [[Economic evaluation]] QALYs per case<br />
<br />
#costpercase <- Ovariable("costpc", ddata = "Op_en6358.costs_incurred") # [[Economic evaluation]] QALYs per case<br />
<br />
#QALY <- VacIPD * QALYpercase <br />
<br />
#cost <- VacIPD * costpercase + vacprice<br />
<br />
# Sum over Serotype<br />
VacIPD <- oapply(VacIPD, NULL, sum, c("Serotype"), na.rm = TRUE)<br />
<br />
Costs <- EvalOutput(Costs) # Healthcare costs<br />
Total_costs <- oapply(Costs, NULL, sum, c("Outcome", "Age"))<br />
#oprint(Total_costs)<br />
Total_costs <- oapply(Total_costs, Total_costs@output[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], mean)<br />
health_care_costs <- Total_costs<br />
Total_costs <- Total_costs + vacprice<br />
Total_costs@output <- Total_costs@output[c(colnames(Total_costs@output)[colnames(Total_costs@output) %in% c("Vaccine", "Iter")], "Result")]<br />
Total_costs@marginal <- colnames(Total_costs@output) %in% c("Vaccine", "Iter")<br />
<br />
QALYs <- EvalOutput(QALYs)<br />
<br />
<br />
<br />
#### Tässä voi tehdä tapauskohtaista säätöä valitsemalla sopivat indeksit.<br />
<br />
qalyind <- "Vaccine"<br />
if("Iter" %in% colnames(QALYs@output)) qalyind <- c(qalyind, "Iter")<br />
<br />
#costind <- "Vaccine"<br />
#if("Iter" %in% colnames(Total_costs@output)) costind <- c(costind, "Iter")<br />
<br />
qalysum <- oapply(QALYs, INDEX = QALYs@output[qalyind], FUN = sum)<br />
qalysum@name <- ""<br />
colnames(qalysum@output)[colnames(qalysum@output) == "QALYsResult"] <- "Result"<br />
<br />
#costsum <- oapply(Total_costs, INDEX = Total_costs@output[costind], FUN = sum)<br />
costsum <- Total_costs<br />
<br />
#oprint(costsum)<br />
#oprint(qalysum)<br />
<br />
#### The actual model<br />
<br />
ICER <- EvalOutput(ICER)<br />
<br />
<br />
if (1==2) {<br />
oprint(<br />
qalysum, <br />
include.rownames = FALSE, <br />
caption = "QALYs lost due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
health_care_costs, <br />
include.rownames = FALSE, <br />
caption = "Health care costs due to IPD", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
costsum,<br />
include.rownames = FALSE, <br />
caption = "Total costs (health care + vaccination)", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
ICER, <br />
include.rownames = FALSE, <br />
caption = "Cost-effectiveness of vaccination choices", <br />
caption.placement = "top"<br />
)<br />
<br />
oprint(<br />
sumtable(), <br />
include.rownames = FALSE, <br />
caption = "Summary table", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
if (!is.null(debug_plot)) {<br />
temp <- QALYs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot1 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = QALYsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "QALYs lost due to IPD", y = "QALYs lost per year")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- Costs<br />
temp <- oapply(temp, NULL, sum, "Outcome")<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot2 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = CostsResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD health care cost (excl. vaccination)", y = "")<br />
# + facet_wrap(~ Outcome)<br />
<br />
temp <- VacIPD<br />
temp@output$Age <- as.numeric(as.character(temp@output$Age))<br />
plot3 <- ggplot(<br />
temp@output, <br />
aes(x = Age, y = VacIPDResult, colour = Vaccine, group = Vaccine)<br />
) + geom_line() + theme_gray(base_size = 24) + labs(title = "IPD cases per year", y = "Cases per year")<br />
}<br />
if (!is.null(debug_plot)) plot3<br />
if (!is.null(debug_plot)) plot2<br />
if (!is.null(debug_plot)) plot1<br />
<br />
# Rigid implementation which doesnt allow uncertainty, for debugging purposes<br />
<br />
qorder <- qalysum@output$Vaccine[order(result(qalysum), decreasing = TRUE)]<br />
<br />
QALYs_incremental <- c(0, -diff(result(qalysum)[match(qorder, qalysum@output$Vaccine)]))<br />
QALYs_gained <- cumsum(QALYs_incremental)<br />
Cost_total <- result(Total_costs)[match(qorder, Total_costs@output$Vaccine)]<br />
Cost_incremental <- c(0,diff( Cost_total))<br />
ICER2 <- Cost_incremental / QALYs_incremental<br />
ICER2[1] <- 0<br />
<br />
if (1==2) {<br />
oprint(<br />
oapply(VacIPD, VacIPD@output["Vaccine"], sum), <br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
)<br />
}<br />
<br />
<br />
vaccres<-matrix(result(VacIPD),101,3)[,c(3,1,2)]<br />
ipdsums<-apply(vaccres,2,sum)<br />
ipdtable<-data.frame(Vaccination_____=c("No vaccination ","PCV10 ","PCV13 "),N_of_IPD_cases____=round(ipdsums))<br />
<br />
oprint(ipdtable,<br />
include.rownames = FALSE, <br />
caption = "Table 1. Number of cases of invasive pneumococcal disease (IPD) per year (see also Figures 1-2 below).", <br />
caption.placement = "top"<br />
) <br />
<br />
<br />
<br />
##############################<br />
## print healt care costs table<br />
<br />
sum_table1A <- data.frame(<br />
Vaccine__ = qorder,<br />
Medical_costs__ = 0.01*round((result(health_care_costs)/1E4)[match(qorder,health_care_costs@output$Vaccine)]),<br />
Vaccine_programme_cost__ = 0.01*round(result(vacprice)/1E4),<br />
Health_care_costs__ = 0.01*round((result(costsum)/1E4)[match(qorder,costsum@output$Vaccine)])<br />
)<br />
oprint(<br />
sum_table1A,<br />
include.rownames = FALSE, <br />
caption = "Table 2. Health care costs (in MEUR)", <br />
caption.placement = "top"<br />
)<br />
<br />
##############################<br />
## print summary table<br />
<br />
<br />
<br />
tekstia<-data.frame(Columns=c(" 1 Vaccine ",<br />
" 2 QALYs gained ",<br />
" 3 Incremental effect ",<br />
" 4 Health-case costs ",<br />
" 5 Incremental cost ",<br />
" 6 ICER ",<br />
" "),<br />
Content=c("vaccination programme",<br />
"QALYs gained in the Finnish population (*) as compared to 'no vaccination'",<br />
"difference in QALYs gained",<br />
"medical costs due to IPD in the Finnish population(*) plus the cost of vaccination (in MEUR, 180000 doses) ",<br />
"health-care cost difference (in MEUR)",<br />
"incremental cost-effectiveness ratio (in euros). The programme with the lower ICER is identified as the more cost-effective",<br />
"(*) QALYs and health-care costs refer to the Finnish population of 5.4 million individuals"))<br />
<br />
oprint(tekstia, include.rownames = FALSE, include.colnames = FALSE, <br />
caption = "Columns appearing in Table 3 (below)", <br />
caption.placement = "top")<br />
<br />
<br />
<br />
sum_table2 <- data.frame(<br />
Vaccine = qorder,<br />
QALYs_gained__ = round(QALYs_gained),<br />
Incremental_effect__ = round(QALYs_incremental),<br />
Health_care_costs__ = 0.01*round(Cost_total/1E4),<br />
Incremental_cost__ = 0.01*round(Cost_incremental/1E4),<br />
ICER__ = ICER2<br />
)<br />
<br />
oprint(<br />
sum_table2,<br />
include.rownames = FALSE, <br />
caption = "Table 3. Cost-effectiveness analysis summary table ", <br />
caption.placement = "top"<br />
)<br />
</rcode><br />
<br />
<br />
==== Variable initiation (Only for developers) ====<br />
<br />
<br />
<br />
<rcode name="initiate" label="Initiate variables" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
# Initiate model components<br />
<br />
primary_outcomes <- Ovariable("primary_outcomes", ddata = "Op_en6358.primary_outcomes")<br />
secondary_outcomes <- Ovariable("secondary_outcomes", ddata = "Op_en6358.secondary_outcomes")<br />
costs_per_outcomes <- Ovariable("costs_per_outcomes", ddata = "Op_en6358.costs_per_outcomes")<br />
QALYs_per_outcomes <- Ovariable("QALYs_per_outcomes", ddata = "Op_en6358.QALYs_per_outcomes")<br />
<br />
Outcomes <- Ovariable(<br />
"Outcomes", <br />
dependencies = data.frame(<br />
Name = c("primary_outcomes", "secondary_outcomes", "VacIPD"),<br />
Ident = c(rep("Op_en6358/initiate", 2), "Op_en6353/initiate")<br />
),<br />
formula = function(...) {<br />
# Primaries<br />
out <- VacIPD * primary_outcomes<br />
<br />
# Secondaries<br />
temp <- out * secondary_outcomes<br />
<br />
# Combine outcomes under single index<br />
temp@output <- temp@output[!colnames(temp@output) %in% "Outcome"]<br />
colnames(temp@output)[colnames(temp@output) == "Outcome_new"] <- "Outcome"<br />
temp@output <- temp@output[colnames(temp@output) %in% colnames(out@output)]<br />
out <- orbind(out, temp)<br />
return(out)<br />
}<br />
)<br />
<br />
# Healthcare costs<br />
Costs <- Ovariable(<br />
"Costs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "costs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * costs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
# QALYs lost<br />
QALYs <- Ovariable(<br />
"QALYs", <br />
dependencies = data.frame(<br />
Name = c("Outcomes", "QALYs_per_outcomes"),<br />
Ident = rep("Op_en6358/initiate", 2)<br />
),<br />
formula = function(...) {<br />
out <- Outcomes * QALYs_per_outcomes<br />
return(out)<br />
}<br />
)<br />
<br />
<br />
# Initiate analysis ovariable ICER and function sumtable<br />
<br />
ICER <- Ovariable("ICER", <br />
dependencies = data.frame(Name = c(<br />
"qalysum", <br />
"costsum",<br />
"QALYs"<br />
)),<br />
formula = function(...) {<br />
<br />
qalyorder <- oapply(QALYs, INDEX = QALYs@output["Vaccine"], FUN = sum)<br />
qalyorder <- as.character(qalyorder@output$Vaccine[order(result(qalyorder), decreasing = TRUE)])<br />
<br />
qalysum2 <- qalysum<br />
costsum2 <- costsum<br />
<br />
# Take the Vaccine group from the previous group (based on reverse QALY order, i.e. worst first.<br />
levels(qalysum2@output$Vaccine) <- qalyorder[match(levels(qalysum2@output$Vaccine), qalyorder) + 1]<br />
levels(costsum2@output$Vaccine) <- qalyorder[match(levels(costsum2@output$Vaccine), qalyorder) + 1]<br />
<br />
# Remove NAs from the index or otherwise they will match anything.<br />
qalysum2@output <- qalysum2@output[!is.na(qalysum2@output$Vaccine) , ]<br />
costsum2@output <- costsum2@output[!is.na(costsum2@output$Vaccine) , ]<br />
<br />
out <- (costsum - costsum2) / (-1 * (qalysum - qalysum2)) # The formula calls for QALY _savings_, hence * -1<br />
<br />
return(out)<br />
}<br />
)<br />
<br />
sumtable <- function() {<br />
out <- merge(<br />
merge(<br />
merge(<br />
qalysum@output, <br />
costsum@output, by = "Vaccine"<br />
),<br />
vacprice@output, all.x = TRUE<br />
),<br />
ICER@output, all.x = TRUE<br />
)<br />
<br />
out <- out[c("Vaccine", "Result.x", "Result.y", "vacpriceResult", "ICERResult")]<br />
colnames(out) <- c("Vaccine", "QALY", "Costs incl. price", "Vaccination price", "ICER")<br />
out <- out[ order(out$QALY, decreasing = TRUE) , ]<br />
<br />
return(out)<br />
}<br />
<br />
objects.store(primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER, sumtable)<br />
<br />
cat("Initiated ovariables primary_outcomes, secondary_outcomes, costs_per_outcomes, QALYs_per_outcomes, Outcomes, Costs, QALYs, ICER and function sumtable\n")<br />
<br />
</rcode><br />
<br />
==== Cost calculation (Only for developers) ====<br />
<br />
<rcode name="cost_calculation" label="Initiate cost calculation objects" embed=1><br />
<br />
library(OpasnetUtils)<br />
<br />
<br />
cost_table <- opasnet.csv("/0/0e/Pneumococcus_cost_table.csv", wiki = "opasnet_en")<br />
<br />
<br />
<br />
<br />
<br />
#cost_table<-re#ad.table("Cost_Table.dat")<br />
## 101*8 taulukko<br />
<br />
## Title of cost_table:<br />
## QALY losses and medical costs per case, separately for meningitis and bacteremia. <br />
## (Note: QALY losses and costs for meningitis cases include sequlae.)<br />
<br />
<br />
##Columns of cost_table :<br />
#1# Age (years)<br />
age<-cost_table[,1]<br />
#2# QALYs lost due to one meningitis case (incl. sequlae)<br />
QALY_men<-cost_table[,2]<br />
#3# QALYs lost due to one bacteremia case<br />
QALY_bac<-cost_table[,3]<br />
#4# case-fatality ratio for a meningitis or bacteremia case (ie for an IPD case)<br />
CFR<-cost_table[,4]<br />
#5# life years lost per one fatal IPD case<br />
LYL<-cost_table[,5]<br />
#6# Medical costs due to one meningitis case (including sequlae)<br />
COST_men<-cost_table[,6]<br />
#7# Medical costs due to one bacteremia case<br />
COST_bac<-cost_table[,7]<br />
#8# Proportion of meningitis cases among all IPD cases (rest are bacteremia)<br />
PROP_men<-cost_table[,8]<br />
<br />
## Tässä koodissa "Cost_calculation.R" luetaan taulukko "Cost_Table.dat" ja muunnetaan <br />
## se taukukoksi "Loss_per_IPDcase" vastaamaan yhtä IPD tapausta. <br />
##<br />
## Tällöin kust.vaik.-mallin antamat tulokset saadaan funktiossa <br />
## "calc_qalys_and_med_costs" kun argumentiksi annetaan IPD tapausten määrät <br />
## Suomessa ikävuosittain (101 kpl). Nämä IPD tapausten määrät vastaavat joko <br />
## "ei rokoteta" tilannetta tai lasketaan epidemiologisen mallin avulla eri <br />
## rokotevaihtiehdoille. (opasnetissä IPD-vektorit saadaan siis ovariablien kautta).<br />
##<br />
## Funktio "calc_3_ouput_tables" tuottaa 3 tulostaulukkoa. <br />
## Nämä ovat kust.vaik.-mallin lopputulokset.<br />
<br />
## Markku Nurhonen 15.8.2014<br />
######################################################################################<br />
<br />
<br />
<br />
<br />
## Adjust matrix "Loss_per_case" to correspond to one ipd case<br />
## (instead of just meningitis or bacterremia case)<br />
onevec<-rep(1,101)<br />
adjustment<-cbind(onevec,PROP_men,(onevec-PROP_men),onevec,CFR,PROP_men,(onevec-PROP_men),onevec)<br />
Loss_per_case<-cbind(age,QALY_men,QALY_bac,CFR,LYL,COST_men,COST_bac,PROP_men)<br />
Loss_per_IPDcase<-Loss_per_case*adjustment<br />
<br />
## Matriisia Loss_per_IPDcase käytetään päivitettäessä<br />
## kustannuksia ja QALY-arvoja IPD insidenssien muuttuessa<br />
## rokotteiden vaihtuessa<br />
<br />
calc_qalys_and_med_costs<-function(ipd_novacc,ipd,Loss_per_IPDcase)<br />
## for two given 101-long IPD vectors<br />
## ipd_novacc = ipd under NO vaccination<br />
## ipd = ipd under vaccination<br />
## this function gives a list of <br />
## non-fatal,fatal and total QALYs gained: result[[1]]:(1,2,3)<br />
## and medical costs under novacc and vacc: result[[2]]:(1,2)<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
{<br />
Loss_total_novacc<-matrix(ipd_novacc,101,8)*Loss_per_IPDcase<br />
Loss_total<-matrix(ipd,101,8)*Loss_per_IPDcase<br />
Gain<-apply(Loss_total_novacc-Loss_total,2,sum) ##koko populaatio<br />
## Now columns 2+3 are nonfatal, 5 is fatal QALYs<br />
## list Qalys gained: nonfatal, fatal and total<br />
QALYs<-c(Gain[2]+Gain[3], Gain[5], Gain[2]+Gain[3]+Gain[5])<br />
## Now columns 6+7 are medical costs<br />
## list med cost under novacc and vacc<br />
medical_cost0<-cbind(Loss_total_novacc[,6]+Loss_total_novacc[,7],Loss_total[,6]+Loss_total[,7])<br />
medical_cost<-apply(medical_cost0,2,sum)<br />
list(QALYs,medical_cost)<br />
}<br />
<br />
<br />
calc_3_output_tables<-function(ipd0,ipd1,ipd2,vaccine_cost1,vaccine_cost2,Loss_per_IPDcase)<br />
## for 3 given 101-long IPD vectors<br />
## ipd0 = ipd under NO vaccination<br />
## ipd1= ipd under vaccination 1<br />
## ipd1= ipd under vaccination 2<br />
## and<br />
## vaccine_cost1,vaccine_cost2=<br />
## per dose costs of vaccines 1 and 2<br />
## Loss_per_IPDcase is a 101*8 matrix<br />
##<br />
## calculate a list of 3 output tables<br />
## rows and columns as indicated below<br />
##<br />
## typical call of this function:<br />
## calc_3_ouput_tables(IPD_noVac,IPD_pcv10,IPD_pcv13,20,40,Loss_per_IPDcase)<br />
{<br />
c1<-calc_qalys_and_med_costs(ipd0,ipd1,Loss_per_IPDcase)<br />
c2<-calc_qalys_and_med_costs(ipd0,ipd2,Loss_per_IPDcase)<br />
<br />
## output table 1<br />
## columns(3): vaccination, non fatal, fatal and total qalys gained<br />
## rows: no_vacc, vacc1, vacc2<br />
table1<-rbind(rep(0,3),c1[[1]],c2[[1]])<br />
qalys_gained<-table1[,3]<br />
<br />
## output table 2<br />
## columns(3): medical costs, vaccination programme costs, health care costs<br />
##rows: no_vacc, vacc1, vacc2<br />
vaccine_cost_tot<-180000*c(0,vaccine_cost1,vaccine_cost2)<br />
med_cost<-c(c1[[2]],c2[[2]][2])<br />
healthcare_cost<-med_cost+vaccine_cost_tot<br />
table2<-cbind(med_cost,vaccine_cost_tot,healthcare_cost)<br />
<br />
## ouput table3<br />
## columns(5): 1.QALYs gained compared to no_vacc<br />
## 2.incremental effects (=incremental QALYS gained)<br />
## 3.Health care costs 4.incremental costs<br />
## 5.ICER=column4/column2<br />
##rows: no_vacc, vacc1, vacc2<br />
<br />
incr_qalys<-(c(qalys_gained,0)-c(0,qalys_gained))[seq(3)]<br />
incr_costs<-(c(healthcare_cost,0)-c(0,healthcare_cost))[seq(3)]<br />
table3<-cbind(qalys_gained,incr_qalys,healthcare_cost,incr_costs,c(0,incr_costs[-1]/incr_qalys[-1]))<br />
<br />
list(table1,table2,table3)<br />
} <br />
<br />
objects.store(age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables<br />
)<br />
<br />
cat("Objects age, QALY_men, QALY_bac, CFR, LYL, COST_men, COST_bac, PROP_men, onevec, adjustment, Loss_per_case, <br />
Loss_per_IPDcase, calc_qalys_and_med_costs, calc_3_output_tables successfully stored.\n"<br />
)<br />
<br />
</rcode><br />
<br />
== Rationale == <br />
Vaccination programmes are ranked in ascending order according to their effectiveness. The effectiveness is measured as the expected reduction in invasive pneumococcal disease, as predicted by the [[Epidemiological_modelling|epidemiological model]]. <br />
Alternatives for which there is at least one other alternative with lower cost and better effectiveness are first excluded.<br />
Each programme ('A') is then compared to the next more effective programme ('B') by the incremental cost-effectiveness ratio (ICER):<br />
<br />
<math>ICER = \frac{(C_B-S_B) - (C_A-S_A)}{E_B-E_A},</math><br />
<br />
where C is the price of the vaccination program, S is the savings in health care costs (as compared to strategy 'no vaccination') and E is the savings in QALYs (as compared to 'no vaccination'). Any programme that is followed by a (more effective) programme with a smaller ICER (i.e. one which produces an additional unit of effect with lower cost) is dropped off from further consideration. The ICERs are then re-calculated and the procedure repeated as many times as needed to eventually identify the most cost-effective alternative. <br />
<br />
<br />
<br />
=== Costs ===<br />
<br />
Health care resource use in secondary health care, per IPD case and sequelae after meningitis, were estimated from the Hospital Discharge Register (2000-2006). For each meningitis and bacteremia case, an episode of care was constructed by linking the outpatient visits and inpatient hospitalizations, using the unique personal identity code. The case fatality ratio (CFR) for IPD was obtained from a Finnish study [Klemets P, Lyytikäinen O, Ruutu P, Ollgren J, Nuorti P. Incidence and outcome of invasive Streptococcus pneumonia infections, Finland, 1995 /2002. In: The 4th International Symposium on Pneumococci and Pneumococcal Diseases (ISPPD); 2004 May 9 /13 2004; Helsinki; 2004.]. The unit costs for hospitalizations and outpatient visits were estimated based on individual-level cost accounting data from one hospital district. Other unit cost estimates were mainly taken from a widely used national price list for the unit costs of health care in Finland. The costs were presented in 2012 prices and were evaluated from the health care provider perspective. Future costs and benefits were discounted at 3% per annum. <br />
<br />
=== Sensitivity ===<br />
<br />
The effects of alternative vaccine compositions on the outcomes of the cost-benefit analysis were assessed. Five modifications for PCV10 and one for PCV13 were considered Conclusion: The assumption about serotype 3 in PCV13 is crucial. In addition, assumptions about the role of 6A in PCV10 is important. For results, see [[Cost_effectiveness_sensitivity]].<br />
<br />
<br />
<br />
=== Data ===<br />
<br />
The data table to appear.<br />
<br />
== See also ==<br />
<br />
{{pneumococcal vaccine}}<br />
<br />
== References ==<br />
<br />
<references/><br />
<br />
== Comment the content ==<br />
<br />
{{commenting tool}}</div>Mnud