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:

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.

------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

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")
  )
}

------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

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/PrescRiptions documentation built on June 12, 2020, 10:38 a.m.