In muschitiello/Rplp: aggregations and reports on Practice Level Prescription Data in England
knitr::opts_chunk$set(echo = FALSE)
ggplot2::theme_set(ggthemes::theme_economist()) # Sets graphs themes to "The Economist" style
for (i in 1:length(params$monthData)){
# print(names(dataAll)[i])
assign(gsub("[[:digit:]]|_","",names(monthData))[i],params$monthData[[i]])
}
bnf[,BNF.Presentation.Code:=as.character(BNF.Presentation.Code)]
regionPrescriptions = PrescRiptions::generateSummaries(plpd,bnf,on = "REGION",params$settings)
bnfPrescriptions = PrescRiptions::generateSummaries(plpd,bnf,on = "BNF",params$settings)
## CCGs
ccgSum = ccgSummaries(plpd,bnf,demog,demogMap,params$settings)
ccg_summary = ccgSum$ccg_summary %>%
data.table
ccg_bnf = ccgSum$ccg_bnf %>%
data.table
ccg_aggr= ccgSum$ccg_aggr %>%
mutate(NIC_RATE_Z=scale(NIC_RATE)[,]) %>%
mutate(NIC_RATE_Z_TYPE=ifelse(NIC_RATE_Z < -1, "Cost Below Average", ifelse(NIC_RATE_Z < 1, "Average Cost", "Cost Above Average"))) %>%
data.table
ccg_summaryC = ccg_summary %>%
dplyr::filter(ONS_CCG_CODE == params$selccg) %>%
data.table
ccg_bnfC = ccg_bnf %>%
dplyr::filter(ONS_CCG_CODE == params$selccg)%>%
data.table
ccg_aggrC= ccg_aggr %>%
dplyr::filter(ONS_CCG_CODE == params$selccg)%>%
data.table
# GPs
gpSum = gpSummaries(plpd,demog,demogMap,params$settings)
# gpSumC = gpSum %>%
# dplyr::filter(PRACTICE == params$selgp)%>%
# data.table
gpSum[,NIC_RATE := round(NIC_RATE,2)]
gpCostlier = gpSum[NIC_RATE_Z >2,2:8]
#
# gpSumT = copy(gpSum)
#
# data.table::setDT(gpSumT)[, (colnames(gpSumT)):= lapply(.SD, function(x) format(x,big.mark = ".",decimal.mark = ",",scientific = FALSE)),
# .SDcols = colnames(gpSumT)]
#
#
# gpC = plpd[PRACTICE == params$selgp]
# gpC[,REGION:="Practice"]
# # bnf[,BNF.Presentation.Code:=as.character(BNF.Presentation.Code)]
# gpC = data.table(left_join(gpC, bnf, by = c("BNF.CODE" = "BNF.Presentation.Code")))
#
# groupVar3 <- c("PERIOD", "PRACTICE")
# measures <- c("ITEMS","NIC", "ACT.COST", "QUANTITY", "PERIOD", "PRACTICE", "BNF.CODE" )
#
# gpCsum <- gpC %>%
# dplyr::select(PERIOD,all_of(measures)) %>%
# dplyr::group_by_at(groupVar3) %>%
# dplyr::summarise(ITEMS = sum(ITEMS), NIC = sum(NIC), ACT.COST = sum(ACT.COST), QUANTITY = sum(QUANTITY))%>%
# data.table
#
# groupVar2 <- c("PERIOD", "PRACTICE", "BNF.Chapter")
#
# gpCsumCode <- gpC %>%
# dplyr::select(PERIOD,all_of(measures), BNF.Chapter, BNF.Chapter.Code) %>%
# dplyr::group_by_at(groupVar2) %>%
# dplyr::summarise(ITEMS = sum(ITEMS), NIC = sum(NIC), ACT.COST = sum(ACT.COST), QUANTITY = sum(QUANTITY))%>%
# data.table
#
#
# gpSum = gpSum[!is.na(NIC_RATE_Z)]
# gpSum = gpSum %>%
# mutate(NIC_RATE_Z=scale(NIC_RATE)[,]) %>%
# mutate(NIC_RATE_Z_TYPE=ifelse(NIC_RATE_Z < -1, "Cost Below Average", ifelse(NIC_RATE_Z < 1, "Average Cost", "Cost Above Average"))) %>%
# data.table
#
# gpSum[PRACTICE==params$selgp,NIC_RATE_Z_TYPE:="Cost for selected GP"]
Sys.setlocale("LC_TIME", "English")
if(nrow(plpd)<=500000){
Psample="YES"
}
if(Psample=="YES"){
dataSample = "SAMPLE PLPD DATA (500.000 ROWS)"
m1Sample = "complete data"
m2Sample = "sample = FALSE"
}else{
dataSample = "TOTAL PLPD DATA"
m1Sample = "sample data"
m2Sample = "sample = TRUE"
}
Authors: Cristina Muschitiello - Niccolò Stamboglis
e-Rum2020 - 20th June 2020
r format(Sys.time(), '%e %B %Y')
This document is automatically generated using the package PrescRiptions.
It is composed of the following sections:
-
Report By Region: r params$geoArea - r params$monthTitle : Summary section for the Region.
-
Report By CCG (customised section): CCG r params$selccg-r params$monthTitle: customised Section by CCG.
All the analyses have been run on r dataSample. For r m1Sample data, set r m2Sample in the monthlyDataImport() function.
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Report by Region
r params$geoArea - r params$monthTitle
Summary
In r params$geoArea during r params$monthTitle the following numbers were registered:
numCols = colnames(regionPrescriptions)
data.table::setDT(regionPrescriptions)[, (numCols):= lapply(.SD, function(x) format(x,big.mark = ".",decimal.mark = ",",scientific = FALSE)),
.SDcols = numCols]
knitr::kable(t(regionPrescriptions[,2:5]),format = "html",
caption = "Region Numbers") %>%
kableExtra::kable_styling(latex_options = c("hold_position", "repeat_header","striped")
,bootstrap_options = c("hold_position", "repeat_header","striped", "hover", "condensed", "responsive"),
full_width = F, position = "left"
)
Analysis by BNF Code
Summary table
The information on prescription at r params$geoArea-r params$monthTitle level by BNF chapter are summarised in the following table
numCols = colnames(bnfPrescriptions)
data.table::setDT(bnfPrescriptions)[, (numCols):= lapply(.SD, function(x) format(x,big.mark = ".",decimal.mark = ",",scientific = FALSE)),
.SDcols = numCols]
# reactable(bnfPrescriptions[,1:5], paginationType = "jump", defaultPageSize = 6)
knitr::kable(bnfPrescriptions[,1:5],format = "html",caption = paste0(params$geoArea, " - ",params$monthTitle, " by BNF Chapter")) %>%
kableExtra::kable_styling(latex_options = c("hold_position", "repeat_header","striped")
,bootstrap_options = c("hold_position", "repeat_header","striped", "hover", "condensed", "responsive")
) %>%
kableExtra::scroll_box(height = "350px")
Prescribed items
Prescribed items by BNF code for r params$geoArea-r params$monthTitle are distributed as follows
bnfPrescriptions = PrescRiptions::generateSummaries(plpd,bnf,on = "BNF",params$settings)
p <- ggplot(bnfPrescriptions, aes(x=reorder(BNF.Chapter, -ITEMS), y=ITEMS)) +
geom_bar(stat="identity", width=.5, fill="#E95420") +
labs(title=paste0("Items by BNF Chapter - ",params$geoArea, " - ",params$monthTitle),
# subtitle="England",
caption="source: NHS",
x="BNF.Chapter") +
theme(plot.title = element_text(color="#333333"))+
scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 20))+
scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))+
theme(axis.text.x = element_text(size=9,angle=90, vjust=0.4, hjust=1,color="#333333"))+
theme(axis.text.y = element_text(size=9,vjust=0.4, hjust=1,color="#333333"))+
theme(axis.title.x = element_text(margin=margin(10,10,0,0),color="#333333"))+
theme(axis.title.y = element_text(margin=margin(10,10,10,0),color="#333333"))
p
Actual Costs
Actual costs by BNF code for r params$geoArea-r params$monthTitle are distributed by BNF code as follows
p <- ggplot(bnfPrescriptions, aes(x=reorder(BNF.Chapter, -ACT.COST), y=ACT.COST)) +
geom_bar(stat="identity", width=.5, fill="#E95420") +
labs(title=paste0("Actual costs by BNF Chapter - ",params$geoArea, " - ",params$monthTitle),
# subtitle="England",
caption="source: NHS",
x="BNF.Chapter") +
theme(plot.title = element_text(color="#333333"))+
scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 20))+
scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))+
theme(axis.text.x = element_text(size=9,angle=90, vjust=0.4, hjust=1,color="#333333"))+
theme(axis.text.y = element_text(size=9,vjust=0.4, hjust=1,color="#333333"))+
theme(axis.title.x = element_text(margin=margin(10,10,0,0),color="#333333"))+
theme(axis.title.y = element_text(margin=margin(10,10,10,0),color="#333333"))
p
Prescribed quantity
Total prescribed quantity by BNF code for r params$geoArea-r params$monthTitle are distributed by BNF code as follows
p <- ggplot(bnfPrescriptions, aes(x=reorder(BNF.Chapter, -QUANTITY), y=QUANTITY)) +
geom_bar(stat="identity", width=.5, fill="#E95420") +
labs(title=paste0("Total quantity by BNF Chapter - ",params$geoArea, " - ",params$monthTitle),
# subtitle="England",
caption="source: NHS",
x="BNF.Chapter") +
theme(plot.title = element_text(color="#333333"))+
scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 20))+
scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))+
theme(axis.text.x = element_text(size=9,angle=90, vjust=0.4, hjust=1,color="#333333"))+
theme(axis.text.y = element_text(size=9,vjust=0.4, hjust=1,color="#333333"))+
theme(axis.title.x = element_text(margin=margin(10,10,0,0),color="#333333"))+
theme(axis.title.y = element_text(margin=margin(10,10,10,0),color="#333333"))
p
Costs summary by CCG
This section analyses Net Ingredient Costs per 1K patients in r params$geoArea-r params$monthTitle. Cost analysis might be useful to the NHS for cost-containment.
The figure below provides a graphical representation of Costs by CCG.
ggplot(ccg_aggr, aes(x= NIC_RATE, y= reorder(ONS_CCG_CODE, NIC_RATE))) +
geom_point(stat='identity', aes(col=NIC_RATE_Z_TYPE), size=2) +
scale_color_manual(
values = c("Cost Below Average"="#33ff33", "Average Cost"="#ffef00", "Cost Above Average" = "#E95420")) +
coord_flip()+
ggtitle(paste0("Costs per 1K patients by CCG")) +
theme(plot.title = element_text(color="#333333"))+
xlab("NIC per 1K patients") +
ylab( "CCG") +
theme(axis.text.x = element_blank())+
theme(axis.text.y = element_text(size=9,vjust=0.4, hjust=1,color="#333333"))+
theme(axis.ticks.x =element_blank())+
# theme(axis.line.x =element_blank())+
theme(axis.title.x = element_text(margin=margin(10,10,0,0),color="#333333"))+
theme(axis.title.y = element_text(margin=margin(10,10,10,0),color="#333333"))+
theme(legend.position = "bottom")+
theme(legend.title = element_blank())+
theme(legend.text = element_text(size=9,color="#333333"))
Costlier GPs
Below the list of practices who were in the higher end of the distribution of Net Ingredient Cost per 1K patients is reported. More specifically, the table reports the practices with highest NIC per 1K patients, as identified by the practices having a z-score for NIC per 1K patients higher than 2.
The practices reported in the table are the ones which should be considered as reporting an higher-than usual cost per 1K patients. These are practices which should be carefully considered to understand the reasons for their high per capita costs.
data.table::setDT(gpCostlier)[, (colnames(gpCostlier)):= lapply(.SD, function(x) format(x,big.mark = ".",decimal.mark = ",",scientific = FALSE)),
.SDcols = colnames(gpCostlier)]
if(nrow(gpCostlier)>5){
knitr::kable(gpCostlier,format = "html",
caption = paste0("COSTLIER PRACTICES - ",params$geoArea, " - ",params$monthTitle)) %>%
kableExtra::kable_styling(latex_options = c("hold_position", "repeat_header","striped")
,bootstrap_options = c("hold_position", "repeat_header","striped", "hover", "condensed", "responsive")
) %>%
kableExtra::scroll_box(height = "350px")
}else{
knitr::kable(gpCostlier,format = "html",
caption = paste0("COSTLIER PRACTICES - ",params$geoArea, " - ",params$monthTitle)) %>%
kableExtra::kable_styling(latex_options = c("hold_position", "repeat_header","striped")
,bootstrap_options = c("hold_position", "repeat_header","striped", "hover", "condensed", "responsive")
)
}
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Report by CCG (customised section)
r params$selccg - r params$monthTitle
Summary
numCols = colnames(ccg_summaryC)
data.table::setDT(ccg_summaryC)[, (numCols):= lapply(.SD, function(x) format(x,big.mark = ".",decimal.mark = ",",scientific = FALSE)),
.SDcols = numCols]
knitr::kable(t(ccg_summaryC[,3:6]),format = "html",
caption = paste0("CCG ",params$selccg, " - Summary information")) %>%
kableExtra::kable_styling(latex_options = c("hold_position", "repeat_header","striped")
,bootstrap_options = c("hold_position", "repeat_header","striped", "hover", "condensed", "responsive"),
full_width = F, position = "left"
)
Analysis by BNF Code
Summary table
The information on prescription at CCG r params$selccg-r params$monthTitle level by BNF chapter are summarised in the following table
numCols = colnames(ccg_bnfC)
data.table::setDT(ccg_bnfC)[, (numCols):= lapply(.SD, function(x) format(x,big.mark = ".",decimal.mark = ",",scientific = FALSE)),
.SDcols = numCols]
knitr::kable(ccg_bnfC[,3:7],format = "html",caption = paste0("CCG ",params$selccg, " - ",params$monthTitle, " by BNF Chapter")) %>%
kableExtra::kable_styling(latex_options = c("hold_position", "repeat_header","striped")
,bootstrap_options = c("hold_position", "repeat_header","striped", "hover", "condensed", "responsive")
) %>%
kableExtra::scroll_box(height = "350px")
Prescribed items
Prescribed items by BNF code for CCG r params$selccg-r params$monthTitle are distributed as follows
p <- ggplot(ccg_bnf, aes(x=reorder(BNF.Chapter, -ITEMS), y=ITEMS)) +
geom_bar(stat="identity", width=.5, fill="#E95420") +
labs(title=paste0("Items by BNF Chapter - ","CCG ",params$selccg, " - ",params$monthTitle),
# subtitle=paste0("CCG ",params$selccg),
caption="source: NHS",
x="BNF.Chapter") +
theme(plot.title = element_text(color="#333333"))+
scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 20))+
scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))+
theme(axis.text.x = element_text(size=9,angle=90, vjust=0.4, hjust=1,color="#333333"))+
theme(axis.text.y = element_text(size=9,vjust=0.4, hjust=1,color="#333333"))+
theme(axis.title.x = element_text(margin=margin(10,10,0,0),color="#333333"))+
theme(axis.title.y = element_text(margin=margin(10,10,10,0),color="#333333"))
p
Actual Costs
Actual costs by BNF code for CCG r params$selccg-r params$monthTitle are distributed as follows
p <- ggplot(ccg_bnf, aes(x=reorder(BNF.Chapter, -ACT.COST), y=ACT.COST)) +
geom_bar(stat="identity", width=.5, fill="#E95420") +
labs(title=paste0("Actual costs by BNF Chapter - ","CCG ",params$selccg, " - ",params$monthTitle),
# subtitle="England",
caption="source: NHS",
x="BNF.Chapter") +
theme(plot.title = element_text(color="#333333"))+
scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 20))+
scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))+
theme(axis.text.x = element_text(size=9,angle=90, vjust=0.4, hjust=1,color="#333333"))+
theme(axis.text.y = element_text(size=9,vjust=0.4, hjust=1,color="#333333"))+
theme(axis.title.x = element_text(margin=margin(10,10,0,0),color="#333333"))+
theme(axis.title.y = element_text(margin=margin(10,10,10,0),color="#333333"))
p
Prescribed quantity
Total prescribed quantity by BNF code for CCG r params$selccg-r params$monthTitle are distributed as follows
p <- ggplot(ccg_bnf, aes(x=reorder(BNF.Chapter, -QUANTITY), y=QUANTITY)) +
geom_bar(stat="identity", width=.5, fill="#E95420") +
labs(title=paste0("Total quantity by BNF Chapter - ","CCG ",params$selccg, " - ",params$monthTitle),
# subtitle="England",
caption="source: NHS",
x="BNF.Chapter") +
theme(plot.title = element_text(color="#333333"))+
scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 20))+
scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))+
theme(axis.text.x = element_text(size=9,angle=90, vjust=0.4, hjust=1,color="#333333"))+
theme(axis.text.y = element_text(size=9,vjust=0.4, hjust=1,color="#333333"))+
theme(axis.title.x = element_text(margin=margin(10,10,0,0),color="#333333"))+
theme(axis.title.y = element_text(margin=margin(10,10,10,0),color="#333333"))
p
Cost analysis
The average NIC per 1K patients in the CCG r params$selccg - r params$monthTitle is r round(ccg_aggrC$NIC_RATE,2). This value set the CCG at the r names(which(ccg_aggrC$NIC_RATE < quantile(ccg_aggr$NIC_RATE, probs = seq(0, 1, by= 0.1)))[1]) percentile of the CCG distribution for this indicator.
The figure below provides a graphical comparison of the CCG costs benchmarked with other CCG rates.
ccg_aggr[ONS_CCG_CODE == params$selccg,NIC_RATE_Z_TYPE:="Cost for selected CCG"]
ggplot(ccg_aggr, aes(x= NIC_RATE, y= reorder(ONS_CCG_CODE, NIC_RATE))) +
geom_point(stat='identity', aes(col=NIC_RATE_Z_TYPE), size=2) +
scale_color_manual(
# labels = c("Above Average", "Average", "Below average"),
values = c("Cost Below Average"="#33ff33", "Average Cost"="#ffef00", "Cost Above Average" = "#E95420","Cost for selected CCG" = "#00FFFF")) +
coord_flip()+
ggtitle(paste0("Costs per 1K patients - CCG ",params$selccg)) +
theme(plot.title = element_text(color="#333333"))+
xlab("NIC per 1K patients") +
ylab( "CCG") +
theme(axis.text.x = element_blank())+
theme(axis.text.y = element_text(size=9,vjust=0.4, hjust=1,color="#333333"))+
theme(axis.ticks.x =element_blank())+
# theme(axis.line.x =element_blank())+
theme(axis.title.x = element_text(margin=margin(10,10,0,0),color="#333333"))+
theme(axis.title.y = element_text(margin=margin(10,10,10,0),color="#333333"))+
theme(legend.position = "bottom")+
theme(legend.title = element_blank())+
theme(legend.text = element_text(size=9,color="#333333"))+
geom_point(data=ccg_aggrC , aes(x=NIC_RATE, y=ONS_CCG_CODE), colour="#00FFFF", size=3)+
geom_text(aes(label=ifelse(ONS_CCG_CODE == params$selccg,round(NIC_RATE,3),'')),hjust=0,vjust=-0.8,size=3,color="#333333")
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Data source
Information on prescriptions have been obtained from NHS. Additional information on prescriptions can be found at this website https://digital.nhs.uk/data-and-information/publications/statistical/practice-level-prescribing-data.
All information are made available via the PrescRiption package.
muschitiello/Rplp documentation built on June 13, 2020, 10:10 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
knitr::opts_chunk$set(echo = FALSE) ggplot2::theme_set(ggthemes::theme_economist()) # Sets graphs themes to "The Economist" style
for (i in 1:length(params$monthData)){ # print(names(dataAll)[i]) assign(gsub("[[:digit:]]|_","",names(monthData))[i],params$monthData[[i]]) } bnf[,BNF.Presentation.Code:=as.character(BNF.Presentation.Code)] regionPrescriptions = PrescRiptions::generateSummaries(plpd,bnf,on = "REGION",params$settings) bnfPrescriptions = PrescRiptions::generateSummaries(plpd,bnf,on = "BNF",params$settings) ## CCGs ccgSum = ccgSummaries(plpd,bnf,demog,demogMap,params$settings) ccg_summary = ccgSum$ccg_summary %>% data.table ccg_bnf = ccgSum$ccg_bnf %>% data.table ccg_aggr= ccgSum$ccg_aggr %>% mutate(NIC_RATE_Z=scale(NIC_RATE)[,]) %>% mutate(NIC_RATE_Z_TYPE=ifelse(NIC_RATE_Z < -1, "Cost Below Average", ifelse(NIC_RATE_Z < 1, "Average Cost", "Cost Above Average"))) %>% data.table ccg_summaryC = ccg_summary %>% dplyr::filter(ONS_CCG_CODE == params$selccg) %>% data.table ccg_bnfC = ccg_bnf %>% dplyr::filter(ONS_CCG_CODE == params$selccg)%>% data.table ccg_aggrC= ccg_aggr %>% dplyr::filter(ONS_CCG_CODE == params$selccg)%>% data.table # GPs gpSum = gpSummaries(plpd,demog,demogMap,params$settings) # gpSumC = gpSum %>% # dplyr::filter(PRACTICE == params$selgp)%>% # data.table gpSum[,NIC_RATE := round(NIC_RATE,2)] gpCostlier = gpSum[NIC_RATE_Z >2,2:8] # # gpSumT = copy(gpSum) # # data.table::setDT(gpSumT)[, (colnames(gpSumT)):= lapply(.SD, function(x) format(x,big.mark = ".",decimal.mark = ",",scientific = FALSE)), # .SDcols = colnames(gpSumT)] # # # gpC = plpd[PRACTICE == params$selgp] # gpC[,REGION:="Practice"] # # bnf[,BNF.Presentation.Code:=as.character(BNF.Presentation.Code)] # gpC = data.table(left_join(gpC, bnf, by = c("BNF.CODE" = "BNF.Presentation.Code"))) # # groupVar3 <- c("PERIOD", "PRACTICE") # measures <- c("ITEMS","NIC", "ACT.COST", "QUANTITY", "PERIOD", "PRACTICE", "BNF.CODE" ) # # gpCsum <- gpC %>% # dplyr::select(PERIOD,all_of(measures)) %>% # dplyr::group_by_at(groupVar3) %>% # dplyr::summarise(ITEMS = sum(ITEMS), NIC = sum(NIC), ACT.COST = sum(ACT.COST), QUANTITY = sum(QUANTITY))%>% # data.table # # groupVar2 <- c("PERIOD", "PRACTICE", "BNF.Chapter") # # gpCsumCode <- gpC %>% # dplyr::select(PERIOD,all_of(measures), BNF.Chapter, BNF.Chapter.Code) %>% # dplyr::group_by_at(groupVar2) %>% # dplyr::summarise(ITEMS = sum(ITEMS), NIC = sum(NIC), ACT.COST = sum(ACT.COST), QUANTITY = sum(QUANTITY))%>% # data.table # # # gpSum = gpSum[!is.na(NIC_RATE_Z)] # gpSum = gpSum %>% # mutate(NIC_RATE_Z=scale(NIC_RATE)[,]) %>% # mutate(NIC_RATE_Z_TYPE=ifelse(NIC_RATE_Z < -1, "Cost Below Average", ifelse(NIC_RATE_Z < 1, "Average Cost", "Cost Above Average"))) %>% # data.table # # gpSum[PRACTICE==params$selgp,NIC_RATE_Z_TYPE:="Cost for selected GP"] Sys.setlocale("LC_TIME", "English") if(nrow(plpd)<=500000){ Psample="YES" } if(Psample=="YES"){ dataSample = "SAMPLE PLPD DATA (500.000 ROWS)" m1Sample = "complete data" m2Sample = "sample = FALSE" }else{ dataSample = "TOTAL PLPD DATA" m1Sample = "sample data" m2Sample = "sample = TRUE" }
Authors: Cristina Muschitiello - Niccolò Stamboglis
e-Rum2020 - 20th June 2020
r format(Sys.time(), '%e %B %Y')
This document is automatically generated using the package PrescRiptions. It is composed of the following sections:
-
Report By Region:
r params$geoArea-r params$monthTitle: Summary section for the Region. -
Report By CCG (customised section): CCG
r params$selccg-r params$monthTitle: customised Section by CCG.
All the analyses have been run on r dataSample. For r m1Sample data, set r m2Sample in the monthlyDataImport() function.
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Report by Region
r params$geoArea - r params$monthTitle
Summary
In r params$geoArea during r params$monthTitle the following numbers were registered:
numCols = colnames(regionPrescriptions) data.table::setDT(regionPrescriptions)[, (numCols):= lapply(.SD, function(x) format(x,big.mark = ".",decimal.mark = ",",scientific = FALSE)), .SDcols = numCols] knitr::kable(t(regionPrescriptions[,2:5]),format = "html", caption = "Region Numbers") %>% kableExtra::kable_styling(latex_options = c("hold_position", "repeat_header","striped") ,bootstrap_options = c("hold_position", "repeat_header","striped", "hover", "condensed", "responsive"), full_width = F, position = "left" )
Analysis by BNF Code
Summary table
The information on prescription at r params$geoArea-r params$monthTitle level by BNF chapter are summarised in the following table
numCols = colnames(bnfPrescriptions) data.table::setDT(bnfPrescriptions)[, (numCols):= lapply(.SD, function(x) format(x,big.mark = ".",decimal.mark = ",",scientific = FALSE)), .SDcols = numCols] # reactable(bnfPrescriptions[,1:5], paginationType = "jump", defaultPageSize = 6)
knitr::kable(bnfPrescriptions[,1:5],format = "html",caption = paste0(params$geoArea, " - ",params$monthTitle, " by BNF Chapter")) %>% kableExtra::kable_styling(latex_options = c("hold_position", "repeat_header","striped") ,bootstrap_options = c("hold_position", "repeat_header","striped", "hover", "condensed", "responsive") ) %>% kableExtra::scroll_box(height = "350px")
Prescribed items
Prescribed items by BNF code for r params$geoArea-r params$monthTitle are distributed as follows
bnfPrescriptions = PrescRiptions::generateSummaries(plpd,bnf,on = "BNF",params$settings) p <- ggplot(bnfPrescriptions, aes(x=reorder(BNF.Chapter, -ITEMS), y=ITEMS)) + geom_bar(stat="identity", width=.5, fill="#E95420") + labs(title=paste0("Items by BNF Chapter - ",params$geoArea, " - ",params$monthTitle), # subtitle="England", caption="source: NHS", x="BNF.Chapter") + theme(plot.title = element_text(color="#333333"))+ scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 20))+ scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))+ theme(axis.text.x = element_text(size=9,angle=90, vjust=0.4, hjust=1,color="#333333"))+ theme(axis.text.y = element_text(size=9,vjust=0.4, hjust=1,color="#333333"))+ theme(axis.title.x = element_text(margin=margin(10,10,0,0),color="#333333"))+ theme(axis.title.y = element_text(margin=margin(10,10,10,0),color="#333333")) p
Actual Costs
Actual costs by BNF code for r params$geoArea-r params$monthTitle are distributed by BNF code as follows
p <- ggplot(bnfPrescriptions, aes(x=reorder(BNF.Chapter, -ACT.COST), y=ACT.COST)) + geom_bar(stat="identity", width=.5, fill="#E95420") + labs(title=paste0("Actual costs by BNF Chapter - ",params$geoArea, " - ",params$monthTitle), # subtitle="England", caption="source: NHS", x="BNF.Chapter") + theme(plot.title = element_text(color="#333333"))+ scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 20))+ scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))+ theme(axis.text.x = element_text(size=9,angle=90, vjust=0.4, hjust=1,color="#333333"))+ theme(axis.text.y = element_text(size=9,vjust=0.4, hjust=1,color="#333333"))+ theme(axis.title.x = element_text(margin=margin(10,10,0,0),color="#333333"))+ theme(axis.title.y = element_text(margin=margin(10,10,10,0),color="#333333")) p
Prescribed quantity
Total prescribed quantity by BNF code for r params$geoArea-r params$monthTitle are distributed by BNF code as follows
p <- ggplot(bnfPrescriptions, aes(x=reorder(BNF.Chapter, -QUANTITY), y=QUANTITY)) + geom_bar(stat="identity", width=.5, fill="#E95420") + labs(title=paste0("Total quantity by BNF Chapter - ",params$geoArea, " - ",params$monthTitle), # subtitle="England", caption="source: NHS", x="BNF.Chapter") + theme(plot.title = element_text(color="#333333"))+ scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 20))+ scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))+ theme(axis.text.x = element_text(size=9,angle=90, vjust=0.4, hjust=1,color="#333333"))+ theme(axis.text.y = element_text(size=9,vjust=0.4, hjust=1,color="#333333"))+ theme(axis.title.x = element_text(margin=margin(10,10,0,0),color="#333333"))+ theme(axis.title.y = element_text(margin=margin(10,10,10,0),color="#333333")) p
Costs summary by CCG
This section analyses Net Ingredient Costs per 1K patients in r params$geoArea-r params$monthTitle. Cost analysis might be useful to the NHS for cost-containment.
The figure below provides a graphical representation of Costs by CCG.
ggplot(ccg_aggr, aes(x= NIC_RATE, y= reorder(ONS_CCG_CODE, NIC_RATE))) + geom_point(stat='identity', aes(col=NIC_RATE_Z_TYPE), size=2) + scale_color_manual( values = c("Cost Below Average"="#33ff33", "Average Cost"="#ffef00", "Cost Above Average" = "#E95420")) + coord_flip()+ ggtitle(paste0("Costs per 1K patients by CCG")) + theme(plot.title = element_text(color="#333333"))+ xlab("NIC per 1K patients") + ylab( "CCG") + theme(axis.text.x = element_blank())+ theme(axis.text.y = element_text(size=9,vjust=0.4, hjust=1,color="#333333"))+ theme(axis.ticks.x =element_blank())+ # theme(axis.line.x =element_blank())+ theme(axis.title.x = element_text(margin=margin(10,10,0,0),color="#333333"))+ theme(axis.title.y = element_text(margin=margin(10,10,10,0),color="#333333"))+ theme(legend.position = "bottom")+ theme(legend.title = element_blank())+ theme(legend.text = element_text(size=9,color="#333333"))
Costlier GPs
Below the list of practices who were in the higher end of the distribution of Net Ingredient Cost per 1K patients is reported. More specifically, the table reports the practices with highest NIC per 1K patients, as identified by the practices having a z-score for NIC per 1K patients higher than 2.
The practices reported in the table are the ones which should be considered as reporting an higher-than usual cost per 1K patients. These are practices which should be carefully considered to understand the reasons for their high per capita costs.
data.table::setDT(gpCostlier)[, (colnames(gpCostlier)):= lapply(.SD, function(x) format(x,big.mark = ".",decimal.mark = ",",scientific = FALSE)), .SDcols = colnames(gpCostlier)] if(nrow(gpCostlier)>5){ knitr::kable(gpCostlier,format = "html", caption = paste0("COSTLIER PRACTICES - ",params$geoArea, " - ",params$monthTitle)) %>% kableExtra::kable_styling(latex_options = c("hold_position", "repeat_header","striped") ,bootstrap_options = c("hold_position", "repeat_header","striped", "hover", "condensed", "responsive") ) %>% kableExtra::scroll_box(height = "350px") }else{ knitr::kable(gpCostlier,format = "html", caption = paste0("COSTLIER PRACTICES - ",params$geoArea, " - ",params$monthTitle)) %>% kableExtra::kable_styling(latex_options = c("hold_position", "repeat_header","striped") ,bootstrap_options = c("hold_position", "repeat_header","striped", "hover", "condensed", "responsive") ) }
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Report by CCG (customised section)
r params$selccg - r params$monthTitle
Summary
numCols = colnames(ccg_summaryC) data.table::setDT(ccg_summaryC)[, (numCols):= lapply(.SD, function(x) format(x,big.mark = ".",decimal.mark = ",",scientific = FALSE)), .SDcols = numCols] knitr::kable(t(ccg_summaryC[,3:6]),format = "html", caption = paste0("CCG ",params$selccg, " - Summary information")) %>% kableExtra::kable_styling(latex_options = c("hold_position", "repeat_header","striped") ,bootstrap_options = c("hold_position", "repeat_header","striped", "hover", "condensed", "responsive"), full_width = F, position = "left" )
Analysis by BNF Code
Summary table
The information on prescription at CCG r params$selccg-r params$monthTitle level by BNF chapter are summarised in the following table
numCols = colnames(ccg_bnfC) data.table::setDT(ccg_bnfC)[, (numCols):= lapply(.SD, function(x) format(x,big.mark = ".",decimal.mark = ",",scientific = FALSE)), .SDcols = numCols] knitr::kable(ccg_bnfC[,3:7],format = "html",caption = paste0("CCG ",params$selccg, " - ",params$monthTitle, " by BNF Chapter")) %>% kableExtra::kable_styling(latex_options = c("hold_position", "repeat_header","striped") ,bootstrap_options = c("hold_position", "repeat_header","striped", "hover", "condensed", "responsive") ) %>% kableExtra::scroll_box(height = "350px")
Prescribed items
Prescribed items by BNF code for CCG r params$selccg-r params$monthTitle are distributed as follows
p <- ggplot(ccg_bnf, aes(x=reorder(BNF.Chapter, -ITEMS), y=ITEMS)) + geom_bar(stat="identity", width=.5, fill="#E95420") + labs(title=paste0("Items by BNF Chapter - ","CCG ",params$selccg, " - ",params$monthTitle), # subtitle=paste0("CCG ",params$selccg), caption="source: NHS", x="BNF.Chapter") + theme(plot.title = element_text(color="#333333"))+ scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 20))+ scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))+ theme(axis.text.x = element_text(size=9,angle=90, vjust=0.4, hjust=1,color="#333333"))+ theme(axis.text.y = element_text(size=9,vjust=0.4, hjust=1,color="#333333"))+ theme(axis.title.x = element_text(margin=margin(10,10,0,0),color="#333333"))+ theme(axis.title.y = element_text(margin=margin(10,10,10,0),color="#333333")) p
Actual Costs
Actual costs by BNF code for CCG r params$selccg-r params$monthTitle are distributed as follows
p <- ggplot(ccg_bnf, aes(x=reorder(BNF.Chapter, -ACT.COST), y=ACT.COST)) + geom_bar(stat="identity", width=.5, fill="#E95420") + labs(title=paste0("Actual costs by BNF Chapter - ","CCG ",params$selccg, " - ",params$monthTitle), # subtitle="England", caption="source: NHS", x="BNF.Chapter") + theme(plot.title = element_text(color="#333333"))+ scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 20))+ scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))+ theme(axis.text.x = element_text(size=9,angle=90, vjust=0.4, hjust=1,color="#333333"))+ theme(axis.text.y = element_text(size=9,vjust=0.4, hjust=1,color="#333333"))+ theme(axis.title.x = element_text(margin=margin(10,10,0,0),color="#333333"))+ theme(axis.title.y = element_text(margin=margin(10,10,10,0),color="#333333")) p
Prescribed quantity
Total prescribed quantity by BNF code for CCG r params$selccg-r params$monthTitle are distributed as follows
p <- ggplot(ccg_bnf, aes(x=reorder(BNF.Chapter, -QUANTITY), y=QUANTITY)) + geom_bar(stat="identity", width=.5, fill="#E95420") + labs(title=paste0("Total quantity by BNF Chapter - ","CCG ",params$selccg, " - ",params$monthTitle), # subtitle="England", caption="source: NHS", x="BNF.Chapter") + theme(plot.title = element_text(color="#333333"))+ scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 20))+ scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))+ theme(axis.text.x = element_text(size=9,angle=90, vjust=0.4, hjust=1,color="#333333"))+ theme(axis.text.y = element_text(size=9,vjust=0.4, hjust=1,color="#333333"))+ theme(axis.title.x = element_text(margin=margin(10,10,0,0),color="#333333"))+ theme(axis.title.y = element_text(margin=margin(10,10,10,0),color="#333333")) p
Cost analysis
The average NIC per 1K patients in the CCG r params$selccg - r params$monthTitle is r round(ccg_aggrC$NIC_RATE,2). This value set the CCG at the r names(which(ccg_aggrC$NIC_RATE < quantile(ccg_aggr$NIC_RATE, probs = seq(0, 1, by= 0.1)))[1]) percentile of the CCG distribution for this indicator.
The figure below provides a graphical comparison of the CCG costs benchmarked with other CCG rates.
ccg_aggr[ONS_CCG_CODE == params$selccg,NIC_RATE_Z_TYPE:="Cost for selected CCG"] ggplot(ccg_aggr, aes(x= NIC_RATE, y= reorder(ONS_CCG_CODE, NIC_RATE))) + geom_point(stat='identity', aes(col=NIC_RATE_Z_TYPE), size=2) + scale_color_manual( # labels = c("Above Average", "Average", "Below average"), values = c("Cost Below Average"="#33ff33", "Average Cost"="#ffef00", "Cost Above Average" = "#E95420","Cost for selected CCG" = "#00FFFF")) + coord_flip()+ ggtitle(paste0("Costs per 1K patients - CCG ",params$selccg)) + theme(plot.title = element_text(color="#333333"))+ xlab("NIC per 1K patients") + ylab( "CCG") + theme(axis.text.x = element_blank())+ theme(axis.text.y = element_text(size=9,vjust=0.4, hjust=1,color="#333333"))+ theme(axis.ticks.x =element_blank())+ # theme(axis.line.x =element_blank())+ theme(axis.title.x = element_text(margin=margin(10,10,0,0),color="#333333"))+ theme(axis.title.y = element_text(margin=margin(10,10,10,0),color="#333333"))+ theme(legend.position = "bottom")+ theme(legend.title = element_blank())+ theme(legend.text = element_text(size=9,color="#333333"))+ geom_point(data=ccg_aggrC , aes(x=NIC_RATE, y=ONS_CCG_CODE), colour="#00FFFF", size=3)+ geom_text(aes(label=ifelse(ONS_CCG_CODE == params$selccg,round(NIC_RATE,3),'')),hjust=0,vjust=-0.8,size=3,color="#333333")
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Data source
Information on prescriptions have been obtained from NHS. Additional information on prescriptions can be found at this website https://digital.nhs.uk/data-and-information/publications/statistical/practice-level-prescribing-data.
All information are made available via the PrescRiption package.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.