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:
r params$geoArea
- r params$monthTitle
: Summary section for the Region.NO CUSTOMISED PARAMETERS HAVE BEEN SELECTED FOR THIS REPORT
All the analyses have been run on r dataSample
. For r m1Sample
data, set r m2Sample
in the monthlyDataImport() function.
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
r params$geoArea
- r params$monthTitle
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" )
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 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 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
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
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"))
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") ) }
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
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.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.