diff --git a/NAMESPACE b/NAMESPACE index 5163a34..800535e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,8 +12,10 @@ export(getHospitalName) export(getLocalYears) export(getNameReshId) export(getRegDataIndikator) +export(getRegDataOpiodReduksjon) export(getRegDataLokalTilsynsrapportMaaned) export(getRegDataRapportDekningsgrad) +export(getRegDataRapportDekningsgradReservasjon) export(getRegDataSmertekategori) export(getRegDataSpinalkateter) export(getSmerteDiagKatValueLab) diff --git a/R/GetRegData.R b/R/GetRegData.R index 4dc1286..9567c0a 100644 --- a/R/GetRegData.R +++ b/R/GetRegData.R @@ -99,7 +99,9 @@ SELECT PasientID, ForlopsID, InklKritOppf, - SkriftligSamtyk + SkriftligSamtyk, + Reservasjonsstatus, + InklusjonStatus FROM AlleVarNum WHERE @@ -116,6 +118,38 @@ WHERE rapbase::loadRegData(registryName, query, dbType) } +#' @rdname getRegData +#' @export +getRegDataRapportDekningsgradReservasjon <- function(registryName, reshId, userRole, + startDate, endDate, ...) { + dbType <- "mysql" + + deps <- .getDeps(reshId, userRole) + + query <- " +SELECT + PasientID, + ForlopsID, + InklKritOppf, + SkriftligSamtyk, + Reservasjonsstatus, + InklusjonStatus +FROM + AlleVarNum +WHERE + AvdRESH IN (" + + query <- paste0(query, deps, ") AND (DATE(StartdatoTO) BETWEEN '", + startDate, "' AND '", endDate, "');") + + if ("session" %in% names(list(...))) { + rapbase::repLogger(session = list(...)[["session"]], + msg = paste0("Load data from ", registryName, ":", query)) + } + + rapbase::loadRegData(registryName, query, dbType) +} + #' @rdname getRegData #' @export getRegDataIndikator <- function(registryName, reshId, userRole, @@ -155,7 +189,11 @@ SELECT var.VidereOppf, var.BehNedtrappAvsluttTils, var.Journalnotat, - var.IkkeMedBeh + var.IkkeMedBeh, + var.AkseptabelSmerte12, + var.AkseptabelSmerte21, + var.Funksjon12, + var.Funksjon21 FROM AlleVarNum var WHERE @@ -180,6 +218,46 @@ WHERE rapbase::loadRegData(registryName, query, dbType) } +#' @rdname getRegData +#' @export +getRegDataOpiodReduksjon <- function(registryName, reshId, userRole, + startDate, endDate, ...) { + + dbType <- "mysql" + + # special case at OUS + deps <- .getDeps(reshId, userRole) + + query <- paste0(" +SELECT + var.MoEkvivalens22, + var.SykehusNavn, + var.StartdatoTO, + var.RegDato11 +FROM + AlleVarNum var +WHERE + var.RegDato11>=DATE('", startDate, "') AND var.RegDato11<=DATE('", endDate, "')" + ) + + if (isNationalReg(reshId)) { + query <- paste0(query, ";") + } else { + query <- paste0(query, " AND var.AvdRESH IN (", deps, ");") + } + + if ("session" %in% names(list(...))) { + session <- list(...)[["session"]] + if ("ShinySession" %in% attr(session, "class")) { + rapbase::repLogger(session = session, + msg = paste("Load opiodrapport data from", + registryName, ": ", query)) + } + } + + rapbase::loadRegData(registryName, query, dbType) +} + #' @rdname getRegData #' @export diff --git a/R/moduleDefaultReport.R b/R/moduleDefaultReport.R index c94663a..7bc32b4 100644 --- a/R/moduleDefaultReport.R +++ b/R/moduleDefaultReport.R @@ -22,13 +22,17 @@ NULL defaultReportInput <- function( id, startDate = lubridate::today() - lubridate::years(1), - endDate = lubridate::today() - lubridate::weeks(1)) { + endDate = lubridate::today() - lubridate::weeks(1), + min = "1980-01-01", + max = "2100-01-01") { shiny::tagList( shiny::dateRangeInput(shiny::NS(id, "dateRange"), label = "Velg periode:", start = startDate, end = endDate, + min = min, + max = max, separator = "-"), shiny::radioButtons(shiny::NS(id, "format"), "Format for nedlasting", diff --git a/inst/LokalDekningsgradrapport.Rmd b/inst/LokalDekningsgradrapport.Rmd index bccaa25..600fd29 100644 --- a/inst/LokalDekningsgradrapport.Rmd +++ b/inst/LokalDekningsgradrapport.Rmd @@ -1,6 +1,6 @@ --- params: - title: 'Dekningsgrad ved' + title: 'Dekningsgrad før reservasjon ved' author: 'Rapporteket' hospitalName: 'Ukjent sykehus' reshId: 'locallyDefined' @@ -62,9 +62,9 @@ if (rapbase::isRapContext()) { ``` -# Dekningsgrad +# Dekningsgrad før reservasjon -Dekningsgraden beregnes lokalt for hvert sykehus. Den viser andelen __forløp__ som oppfyller inklusjonskriteriene der pasienter har samtykket til å være med i registeret. +Dekningsgraden beregnes lokalt for hvert sykehus. Den viser andelen __forløp__ der pasienten har sammtykket til å være med i registeret av de som oppfyller inklusjonskriteriene. ```{r inkludert, results='asis'} @@ -72,18 +72,15 @@ if (dim(dat)[1] < 1) { message <- "I den valgte tidsperioden er det ikke nok data til å angi dekningsgrad." } else { antInk <- sum(dat$InklKritOppf == 1, na.rm = TRUE) - sam <- dat$SkriftligSamtyk - # NA/NULL to be counted as none-consent - sam <- sam %>% replace(is.na(.), 0) - antSam <- sum(sam == 1, na.rm = TRUE) + antReserv <- sum(dat$Reservasjonsstatus == 1, na.rm = TRUE) + inklStat <- sum(dat$InklusjonStatus == 1, na.rm = TRUE) if (antInk < 1) { message <- "I den valgte tidsperioden er det ikke nok data til å angi dekningsgrad." } else { - dekning <- antSam / antInk + dekning <- inklStat / antInk nPatient <- length(unique(dat$PasientID)) nEvent <- length(unique(dat$ForlopsID)) - nNoConsent <- length(sam[sam == 0]) nNoIncl <- length(dat$InklKritOppf[dat$InklKritOppf == 0]) patientTxt <- "." @@ -96,13 +93,13 @@ if (dim(dat)[1] < 1) { } message <- paste0("Dekningsgraden for ", params$hospitalName, " i den valgte tidsperioden er __", - round(dekning, digits = 2), "__. Totalt antall er ", - antInk, " hvorav ", antSam, " samtykker er gitt.") + round(dekning, digits = 2), "__. Antall inkluderte er ", inklStat, " mens totalt antall som oppfyller inklusjonskriteriene er ", + antInk, ".") message <- paste0(message, "\n\n## Tallgrunnlag og utvalg \n", " I utvalget er det ", nEvent, " forløp", patientTxt, - " Totalt ", nNoConsent, - " forløp mangler samtykke og totalt ", nNoIncl, + " Totalt ", antReserv, + " forløp er registrert med reservasjon og totalt ", nNoIncl, " forløp oppfyller ikke inklusjonskriteriene.") } diff --git a/inst/LokalDekningsgradrapportReservasjon.Rmd b/inst/LokalDekningsgradrapportReservasjon.Rmd new file mode 100644 index 0000000..1ba2059 --- /dev/null +++ b/inst/LokalDekningsgradrapportReservasjon.Rmd @@ -0,0 +1,112 @@ +--- +params: + title: 'Dekningsgrad etter reservasjon ved' + author: 'Rapporteket' + hospitalName: 'Ukjent sykehus' + reshId: 'locallyDefined' + userRole: 'MyRole' + userFullName: 'Ukjent bruker' + startDate: '2017-01-01' + endDate: '2017-12-31' + year: '2016' + tableFormat: 'html' + registryName: 'rapbase' + shinySession: list() +title: '`r paste(params$title, params$hospitalName, " i perioden fra ", params$startDate, " til ", params$endDate)`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%d\\. %B, %Y")`' +reglogo: '`r system.file("www/logoSmerte.png", package = "smerte")`' +regtext: '`r readLines(system.file("registryShortDescription.txt", package = "smerte"))`' +registryName: Smerteregisteret +userFullName: '`r params$userFullName`' +--- +```{r set options and load packages, include = FALSE} +knitr::opts_chunk$set(echo=FALSE) +options(knitr.table.format = params$tableFormat) +options(tinytex.verbose = TRUE) +``` + +```{r get data, include=FALSE} + +if (rapbase::isRapContext()) { + dat <- smerte::getRegDataRapportDekningsgradReservasjon( + registryName = params$registryName, + reshId = params$reshId, + userRole = params$userRole, + startDate = params$startDate, + endDate = params$endDate, + session = params$shinySession + ) +} else { + #Dataimport: skal hente lokale data for hvert sykehus (tar vekk sti, og erstatter med lokal filB) + path <- read.csv(file = "H:/path.csv", header = FALSE, sep = ";") + path <- as.data.frame(lapply(path, as.character), stringsAsFactors=FALSE) + path <- path$V1 + dat <- read.csv(file = path, header = TRUE, sep = ";") + + # avdpath <- read.csv(file = "H:/avdelingpath.csv", header = FALSE, sep = ";") + # avdpath <- as.data.frame(lapply(avdpath, as.character), stringsAsFactors=FALSE) + # avdpath <- avdpath$V1 + # avd <- read.csv(file = avdpath, header = TRUE, sep = ";", encoding = "UTF-8") + # #Endrer navn til å matche rapporteket + # avd <- avd %>% rename(DEPARTMENT_ID = AvdID, DEPARTMENT_NAME = AvdNavn, DEPARTMENT_SHORTNAME = AvdNavnKort) + # + # #Samler datasettene vha InnlAvd i allevarnum og departmentID i avdelingsoversikt + # dat <- merge(x = dat, y = avd, by.x = c("InnlAvd"), by.y = c("DEPARTMENT_ID")) + + #Må kunne laste inn data for de ulike årene + #aar <- params$year + #dat = dat %>% filter(year(date(StartdatoTO)) == aar) #year +} + + +``` + +# Dekningsgrad etter reservasjon + +Dekningsgraden beregnes lokalt for hvert sykehus. Den viser andelen __forløp__ der pasienten ikke har reservert seg mot å være med i registeret for de forløp der inklusjonskriterene er oppfylt. + +```{r inkludert, results='asis'} + +if (dim(dat)[1] < 1) { + message <- "I den valgte tidsperioden er det ikke nok data til å angi dekningsgrad." +} else { + antInk <- sum(dat$InklKritOppf == 1, na.rm = TRUE) + antReserv <- sum((dat$Reservasjonsstatus == 1 & dat$InklKritOppf == 1), + na.rm = TRUE) + antReservTOT <- sum(dat$Reservasjonsstatus == 1, na.rm = TRUE) + inklStat <- sum((dat$Reservasjonsstatus == 0 & dat$InklKritOppf == 1), + na.rm = TRUE) + + if (antInk < 1) { + message <- "I den valgte tidsperioden er det ikke nok data til å angi dekningsgrad." + } else { + dekning <- inklStat / antInk + nPatient <- length(unique(dat$PasientID)) + nEvent <- length(unique(dat$ForlopsID)) + nNoIncl <- length(dat$InklKritOppf[dat$InklKritOppf == 0]) + + patientTxt <- "." + if (nPatient > 1) { + patientTxt <- paste(" fordelt på", nPatient, "pasienter.") + } + + if (nPatient == 1) { + patientTxt <- " for én pasient." + } + message <- paste0("Dekningsgraden for ", params$hospitalName, + " i den valgte tidsperioden er __", + round(dekning, digits = 2), "__. Antall inkluderte er ", inklStat, " mens totalt antall som oppfyller inklusjonskriteriene er ", + antInk, ".") + + message <- paste0(message, "\n\n## Tallgrunnlag og utvalg \n", + " I utvalget er det ", nEvent, " forløp", patientTxt, + " For forløp der inklusjonskriteriene er oppfylt er ", antReserv, + " registrert med reservasjon, mens det totalt er ", antReservTOT, " forløp med reservasjon. Det er totalt ", nNoIncl, " forløp som oppfyller ikke inklusjonskriteriene.") + } + +} + +cat(paste(" \n", message)) + +``` diff --git a/inst/LokalIndikatorMaaned.Rmd b/inst/LokalIndikatorMaaned.Rmd index 1217c3b..edd2eb8 100644 --- a/inst/LokalIndikatorMaaned.Rmd +++ b/inst/LokalIndikatorMaaned.Rmd @@ -24,8 +24,12 @@ userFullName: '`r params$userFullName`' knitr::opts_chunk$set(echo=FALSE) options(knitr.table.format = params$tableFormat) options(tinytex.verbose = TRUE) +options(scipen = 1, digits = 2) #set to two decimal library(ggplot2) +library(tidyverse) +library(dplyr) + ``` ```{r get data, warning = FALSE, message=TRUE} @@ -534,8 +538,9 @@ messageik <- "" #Aggregate by month for plot #Grouping by month and finding frequency (remove NA here), then filtering on the "correct" frequency (if not, we get the inverse too) +#Kun de som har blitt tilsett er aktuell for denne plotikmed <- dat %>% - dplyr::filter(!is.na(IkkeMedBeh)) %>% + dplyr::filter(!is.na(IkkeMedBeh), Tilsett == 1) %>% dplyr::group_by(month = monthname, IkkeMedBeh) %>% dplyr::summarise(n = dplyr::n()) %>% dplyr::mutate(freq = n/sum(n)) %>% @@ -643,3 +648,166 @@ if (dim(plotnedtr)[1] < 1) { ``` `r messageplot` + +# Akseptabel smerte +Andel pasienter som har akseptabel smerte ved siste tilsyn. + +```{r aksept, warning = FALSE, message=FALSE, results='asis'} + +messageaks <- "" + +# Klargjøre +if (dim(dat)[1] < 1) { + messageaks <- "I den valgte tidsperioden er det ikke nok data til å angi denne + kvalitetsindikatoren." +} else { + + #Verdier som skal vises i tabell for denne indikatoren + ant <- sum(dat$AkseptabelSmerte21 == 1, na.rm = TRUE) + + totant <- sum(!is.na(dat$AkseptabelSmerte21)) + + and <- ant/totant + + #Før, for sammenligning men ikke indikator + antfoer <- sum(dat$AkseptabelSmerte12 == 1, na.rm = TRUE) + + totantfoer <- sum(!is.na(dat$AkseptabelSmerte12)) + + andfoer <- antfoer/totantfoer + # + #Tabell for siste tilsyn + tabaks <- cbind(ant, totant, and) + + rapbase::mst( + tab = tabaks, + col_names = c("Antall", "Totalt antall", "Andel"), + type = params$tableFormat, + cap = paste0("Oversikt over andel som hadde akseptabel smerte ved siste tilsyn."), + digs = 2, + align = c("r", "r", "r")) + +} + + +``` +`r messageaks` +Andelen med akseptabel smerte ved siste tilsyn ser vi er `r and`, mens den til sammenligning var `r andfoer` ved første tilsyn. + +Figuren under viser hvordan andelen har fordelt seg i løpet av året. + +```{r akseptfig, warning = FALSE, message=FALSE, results='asis', fig.pos= "H", out.extra = '', fig.align='center', out.width='100%'} + +messageplotaks <- "" + +#Aggregate by month for plot +plotaks<- dat %>% + dplyr::filter( + !is.na(AkseptabelSmerte21)) %>% + dplyr::group_by(month = monthname, AkseptabelSmerte21) %>% + dplyr::summarise(n = dplyr::n()) %>% + dplyr::mutate(freq = n/sum(n)) %>% + dplyr::filter(AkseptabelSmerte21 == 1) + +if (dim(plotnedtr)[1] < 1) { + messageplot <- "I den valgte tidsperioden er det ikke nok data til å vise + figur for denne kvalitetsindikatoren." +} else { + + #Plotting plotdat + ggplot2::ggplot(plotaks, ggplot2::aes(month, freq)) + + geom_line(ggplot2::aes(group = 1)) + geom_point() + + labs(x = "Måned", y = "Andel", + subtitle = "Andel med akseptabel smerte ved siste tilsyn per måned") + + theme_classic() + + theme(axis.text.x = element_text(size = 9), + plot.margin = unit(c(1, 1, 2, 0), "cm"), + axis.title.y = element_text(margin = + margin(t = 0, r = 10, b = 0, l = 0)), + axis.title.x = element_text(margin = margin(t = 10, r = 0, b = 0, l = 0))) + +} +``` + +`r messageplotaks` + + +# Endret funksjonsnivå +Andel pasienter hvor funksjon bedrer seg fra første til siste tilsyn. De som ikke hadde bedring kan i tillegg til forverring ha uendret funkjson (mangler det svar på en eller begge målinger er de ikke med i utregningen). + +```{r funk, warning = FALSE, message=FALSE, results='asis'} + +messagefunk <- "" + +# Klargjøre +if (dim(dat)[1] < 1) { + messagefunk <- "I den valgte tidsperioden er det ikke nok data til å angi denne + kvalitetsindikatoren." +} else { + + #Verdier som skal vises i tabell for denne indikatoren + dat$bedring <- NA + for(i in 1:dim(dat)[1]){ + if(!is.na(dat$Funksjon12[i]) & !is.na(dat$Funksjon21[i]) & dat$Funksjon12[i] != 9 & dat$Funksjon21[i] != 9) + {dat$bedring[i] <- dat$Funksjon21[i] - dat$Funksjon12[i]}} + + #De med nedgang i smerte for StSmBe + ant <- sum(dat$bedring > 0, na.rm = TRUE) + + totant <- sum(!is.na(dat$bedring)) + + and <- ant/totant + + #Tabell for siste tilsyn + tabfunk <- cbind(ant, totant, and) + + rapbase::mst( + tab = tabfunk, + col_names = c("Antall", "Totalt antall", "Andel"), + type = params$tableFormat, + cap = paste0("Oversikt over andel som hadde bedring i funksjon fra første til siste tilsyn."), + digs = 2, + align = c("r", "r", "r")) + +} + + +``` +`r messagefunk` + +Figuren under viser hvordan andelen har fordelt seg i løpet av året. + +```{r funkfig, warning = FALSE, message=FALSE, results='asis', fig.pos= "H", out.extra = '', fig.align='center', out.width='100%'} + +messageplotfunk <- "" + +#Aggregate by month for plot +plotfunk<- dat %>% + dplyr::filter( + !is.na(bedring)) %>% + dplyr::group_by(month = monthname, bedring) %>% + dplyr::summarise(n = dplyr::n()) %>% + dplyr::mutate(freq = n/sum(n)) %>% + dplyr::filter(bedring == 1) + +if (dim(plotnedtr)[1] < 1) { + messageplot <- "I den valgte tidsperioden er det ikke nok data til å vise + figur for denne kvalitetsindikatoren." +} else { + + #Plotting plotdat + ggplot2::ggplot(plotfunk, ggplot2::aes(month, freq)) + + geom_line(ggplot2::aes(group = 1)) + geom_point() + + labs(x = "Måned", y = "Andel", + subtitle = "Andel med bedring i funksjonsnivå per måned") + + theme_classic() + + theme(axis.text.x = element_text(size = 9), + plot.margin = unit(c(1, 1, 2, 0), "cm"), + axis.title.y = element_text(margin = + margin(t = 0, r = 10, b = 0, l = 0)), + axis.title.x = element_text(margin = margin(t = 10, r = 0, b = 0, l = 0))) + +} +``` + +`r messageplotfunk` diff --git a/inst/LokalOpioidReduksjon.Rmd b/inst/LokalOpioidReduksjon.Rmd new file mode 100644 index 0000000..5f36a7a --- /dev/null +++ b/inst/LokalOpioidReduksjon.Rmd @@ -0,0 +1,101 @@ +--- +params: + title: 'Opioidreduksjon' + author: 'Rapporteket' + hospitalName: 'Ukjent sykehus' + reshId: 'locallyDefined' + userRole: 'MyRole' + userFullName: 'Ukjent bruker' + startDate: '2017-01-01' + endDate: '2017-12-31' + year: '2016' + tableFormat: 'html' + registryName: 'rapbase' + shinySession: list() +title: '`r paste(params$title, params$hospitalName, " i perioden fra ", params$startDate, " til ", params$endDate)`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%d\\. %B, %Y")`' +reglogo: '`r system.file("www/logoSmerte.png", package = "smerte")`' +regtext: '`r readLines(system.file("registryShortDescription.txt", package = "smerte"))`' +registryName: Smerteregisteret +userFullName: '`r params$userFullName`' +--- +```{r set options and load packages, include = FALSE} +knitr::opts_chunk$set(echo=FALSE) +options(knitr.table.format = params$tableFormat) +options(tinytex.verbose = TRUE) + +library(dplyr) +library(tidyverse) +library(zoo) +library(lubridate) +library(forcats) +library(stringr) +library(readr) +library(magrittr) +library(xtable) +library(kableExtra) + +``` + +```{r setup, include=FALSE} +if (rapbase::isRapContext()) { + dat <- smerte::getRegDataOpiodReduksjon(registryName = params$registryName, + reshId = params$reshId, + userRole=params$userRole, + startDate = params$startDate, + endDate = params$endDate, + session = params$shinySession) +} else { + dat <- path <- read.csv(file = "H:/path.csv", header = FALSE, sep = ";") + path <- as.data.frame(lapply(path, as.character), stringsAsFactors=FALSE) + path <- path$V1 + dat <- read.csv(file = path, header = TRUE, sep = ";") +} +``` + +```{r yearSelect, include=FALSE} +#Hvis vi vil begrense +#dat <- dat[!(dat$MoEkvivalens22 > 10000),] + +#For å evaluere om data er tilstede +dataPresent <- TRUE +if(dim(dat)[1] < 1) { + dataPresent <- FALSE +} + +``` + + +```{r noData, eval=!dataPresent, results='asis'} +cat('# Upps...\nI den valgte tidsperioden er det ikke nok data til å gi + ut resultater.') +knitr::knit_exit() + +``` + +# Oversikt + +Denne oversikten viser resultater for det som begynte som et delmål i kvalitetsforbedringsprosjektet på ikke-medikamentell smertebehandling: Redusere bruk av opioider, målt ved perorale morfinekvivalenter ved siste tilsyn, med 10 % i 2022. + +Dersom et valgt år ikke vises er det ingen registreringer på morfinekvivalenter der. + +## Totalt +```{r overall, include=FALSE} +#Gjennomsnittlig antall forløp +d_moek = dat %>% filter(!is.na(MoEkvivalens22)) %>% + dplyr::group_by(year(StartdatoTO)) %>% + dplyr::summarise(nevner = n(), + ind = sum(MoEkvivalens22)/n()) +``` + +```{r taboverall, results='asis', echo = FALSE} + +rapbase::mst(tab = d_moek, + col_names = c("År", "Antall forløp", "Gj.snitt MoEkv"), + cap = paste0("Gjennomsnittlig mengde morfinekvivalenter per år"), + label = "moek", + type = "html", + digs = 1, + align = c("l", "r", "r", "r")) +``` diff --git a/inst/NasjonalIndikatorMaaned.Rmd b/inst/NasjonalIndikatorMaaned.Rmd index 60e0e5c..ce70d99 100644 --- a/inst/NasjonalIndikatorMaaned.Rmd +++ b/inst/NasjonalIndikatorMaaned.Rmd @@ -25,6 +25,8 @@ userFullName: '`r params$userFullName`' knitr::opts_chunk$set(echo=FALSE) options(knitr.table.format = params$tableFormat) options(tinytex.verbose = TRUE) +options(scipen = 1, digits = 2) #set to two decimal + ``` ```{r get data, warning = FALSE, message=TRUE} @@ -709,7 +711,7 @@ Andel pasienter hvor ikke-medikamentell behandling startes, endres og/eller føl ```{r ikkemed, warning = FALSE, message=FALSE, results='asis'} messageikmed <- "" - +#Kun de som er tilsett er aktuell for denne # Klargjøre if (dim(dat)[1] < 1) { messageikmed <- "I den valgte tidsperioden er det ikke nok data til å angi denne @@ -717,7 +719,7 @@ if (dim(dat)[1] < 1) { } else { ikkmed <- dat %>% - dplyr::filter(!is.na(IkkeMedBeh)) %>% + dplyr::filter(!is.na(IkkeMedBeh), Tilsett == 1) %>% dplyr::group_by(SykehusNavn, IkkeMedBeh) %>% dplyr::summarise(n = dplyr::n()) %>% dplyr::mutate( ant = sum(n), freq = n/sum(n)) %>% @@ -890,3 +892,201 @@ if (dim(plotnedtr)[1] < 1) { } ``` `r messagenedfig` + +# Akseptabel smerte +Andel pasienter som har akseptabel smerte ved siste tilsyn. + +```{r aks, warning = FALSE, message=FALSE, results='asis'} + +messageaks <- "" + +# Klargjøre +if (dim(dat)[1] < 1) { + messageaks <- "I den valgte tidsperioden er det ikke nok data til å angi denne + kvalitetsindikatoren." +} else { + + #VidereOppf, BehNedtrappAvsluttTils og Journalnotat + nedtr <- dat %>% + dplyr::filter(!is.na(AkseptabelSmerte21)) %>% + dplyr::group_by(SykehusNavn, AkseptabelSmerte21) %>% + dplyr::summarise(n = dplyr::n()) %>% + dplyr::mutate( ant = sum(n), freq = n/sum(n)) %>% + dplyr::filter(AkseptabelSmerte21 == 1) + + #Tar bort kolonne + nedtr <- nedtr %>% + dplyr::select(SykehusNavn, n, ant, freq) + + #Tabell + rapbase::mst( + tab = nedtr, + col_names = c("Sykehus", "Antall", "Totalt antall", "Andel"), + type = params$tableFormat, + cap = paste0("Oversikt over andel med akseptabel smerte ved siste tilsyn."), + digs = 2, + align = c("l", "r", "r", "r")) + +} +``` +`r messageaks` + +Figuren under viser hvordan andelen har fordelt seg i løpet av året. + +```{r aksfig, warning = FALSE, message=FALSE, results='asis', fig.pos= "H", out.extra = '', fig.align='center', out.width='100%', fig.width = 14, fig.asp = 0.5} + +messageaksfig <- "" + +plotaks <- dat %>% + dplyr::filter( + !is.na(AkseptabelSmerte21)) %>% + dplyr::group_by(SykehusNavn, monthname, AkseptabelSmerte21) %>% + dplyr::summarise(n = dplyr::n()) %>% + dplyr::mutate(ant = sum(n), freq = n/sum(n)) %>% + dplyr::filter(AkseptabelSmerte21 == 1) + +#Adding the mean of the groups each month +meanplotaks <- plotaks %>% + dplyr::group_by(monthname) %>% + dplyr::summarise(freq = mean(freq)) %>% + dplyr::mutate(SykehusNavn="Snitt", .before = monthname) + +#Merging the two tibbles +plotaks <- dplyr::bind_rows(plotaks, meanplotaks) + +if (dim(plotaks)[1] < 1) { + messageaksfig <- "I den valgte tidsperioden er det ikke nok data til å vise + figur for denne kvalitetsindikatoren." +} else { + + #Plotting plotdat + ggplot2::ggplot(plotaks, ggplot2::aes(monthname, freq)) + + ggplot2::geom_line(ggplot2::aes(group = factor(SykehusNavn), + colour=factor(SykehusNavn)), size = 0.5) + + ggplot2::geom_point(ggplot2::aes(group = factor(SykehusNavn), + colour=factor(SykehusNavn)), size = 1) + + ggplot2::labs(x = "Måned", y = "Andel", + subtitle = "Andel med akseptabel smerte ved siste tilsyn per måned", + color = "Sykehus") + ggplot2::theme_classic() + + ggplot2::theme(axis.text.x = ggplot2::element_text(size = 8.5), + axis.text.y = ggplot2::element_text(size = 10), + axis.title = ggplot2::element_text(size = 10), + plot.margin = ggplot2::unit(c(1, 1, 2, 1), "cm"), + legend.text = ggplot2::element_text(size = 13), + axis.title.y = ggplot2::element_text( + margin = ggplot2::margin(t = 0, r = 10, b = 0, l = 0) + ), + axis.title.x = ggplot2::element_text( + margin = ggplot2::margin(t = 10, r = 0, b = 0, l = 0) + ) + ) + +} +``` +`r messageaksfig` + +# Endret funksjonsnivå +Andel pasienter hvor funksjon bedrer seg fra første til siste tilsyn. De som ikke hadde bedring kan i tillegg til forverring ha uendret funksjon (mangler det svar på en eller begge målinger er de ikke med i utregningen). + +```{r funk, warning = FALSE, message=FALSE, results='asis'} + +messagefunk <- "" + +# Klargjøre +if (dim(dat)[1] < 1) { + messagefunk <- "I den valgte tidsperioden er det ikke nok data til å angi denne + kvalitetsindikatoren." +} else { + + #Verdier som skal vises i tabell for denne indikatoren + # dat$bedring <- NA + # for(i in 1:dim(dat)[1]){ + # if(!is.na(dat$Funksjon12[i]) & !is.na(dat$Funksjon21[i]) & dat$Funksjon12[i] != 9 & dat$Funksjon21[i] != 9) + # {dat$bedring[i] <- dat$Funksjon21[i] - dat$Funksjon12[i]}} + # + # #De med nedgang i smerte for StSmBe + # ant <- sum(dat$bedring > 0, na.rm = TRUE) + # + # totant <- sum(!is.na(dat$bedring)) + # + # and <- ant/totant + # + # #Tabell for siste tilsyn + # tabfunk <- cbind(ant, totant, and) + +funfor = dat %>% + dplyr::filter(!is.na(Funksjon12), !is.na(Funksjon21), Funksjon12 != 9, + Funksjon21 != 9) %>% + dplyr:: mutate(bedring = (Funksjon21 - Funksjon12)) + +funfor1 <- funfor %>% + dplyr::mutate(bedring1 = bedring > 0) %>% + dplyr::group_by(SykehusNavn, bedring1) %>% + dplyr::summarise(n = dplyr::n()) %>% + dplyr::mutate(ant = sum(n), freq = n/sum(n)) %>% + dplyr::filter(bedring1 > 0) + +funfor1 <- funfor1 %>% + dplyr::select(SykehusNavn, n, ant, freq) + +andel_fun= sum(funfor$bedring == 0, na.rm = TRUE) +andel_tot = length(funfor$bedring) +andel_uendret = andel_fun/andel_tot + + rapbase::mst( + tab = funfor1, + col_names = c("Sykehus", "Antall", "Totalt antall", "Andel"), + type = params$tableFormat, + cap = paste0("Oversikt over andel som hadde bedring i funksjon fra første til siste tilsyn."), + digs = 2, + align = c("l", "r", "r", "r")) +} + +``` +`r messagefunk` En andel på `r andel_uendret` (totalt) hadde uendret funksjon. + +Figuren under viser hvordan andelen har fordelt seg i løpet av året. + +```{r funkfig, warning = FALSE, message=FALSE, results='asis', fig.pos= "H", out.extra = '', fig.align='center', out.width='100%'} + +messageplotfunk <- "" + +#Aggregate by month for plot + plotfunk <- funfor %>% + dplyr::mutate(bedring1 = bedring > 0) %>% + dplyr::group_by(SykehusNavn, monthname, bedring1) %>% + dplyr::summarise(n = dplyr::n()) %>% + dplyr::mutate(ant = sum(n), freq = n/sum(n)) %>% + dplyr::filter(bedring1 == 1) + +if (dim(plotfunk)[1] < 1) { + messageplot <- "I den valgte tidsperioden er det ikke nok data til å vise + figur for denne kvalitetsindikatoren." +} else { + + #Plotting plotdat + ggplot2::ggplot(plotfunk, ggplot2::aes(monthname, freq)) + + ggplot2::geom_line(ggplot2::aes(group = factor(SykehusNavn), + colour=factor(SykehusNavn)), size = 0.5) + + ggplot2::geom_point(ggplot2::aes(group = factor(SykehusNavn), + colour=factor(SykehusNavn)), size = 1) + + ggplot2::labs(x = "Måned", y = "Andel", + subtitle = "Andel med forbedring i funksjon per måned", + color = "Sykehus") + ggplot2::theme_classic() + + ggplot2::theme(axis.text.x = ggplot2::element_text(size = 8.5), + axis.text.y = ggplot2::element_text(size = 10), + axis.title = ggplot2::element_text(size = 10), + plot.margin = ggplot2::unit(c(1, 1, 2, 1), "cm"), + legend.text = ggplot2::element_text(size = 13), + axis.title.y = ggplot2::element_text( + margin = ggplot2::margin(t = 0, r = 10, b = 0, l = 0) + ), + axis.title.x = ggplot2::element_text( + margin = ggplot2::margin(t = 10, r = 0, b = 0, l = 0) + ) + ) + +} +``` + +`r messageplotfunk` diff --git a/inst/NasjonalOpioidReduksjon.Rmd b/inst/NasjonalOpioidReduksjon.Rmd new file mode 100644 index 0000000..d3d446d --- /dev/null +++ b/inst/NasjonalOpioidReduksjon.Rmd @@ -0,0 +1,120 @@ +--- +params: + title: 'Opioidreduksjon' + author: 'Rapporteket' + hospitalName: 'Ukjent sykehus' + reshId: 'locallyDefined' + userRole: 'MyRole' + userFullName: 'Ukjent bruker' + startDate: '2017-01-01' + endDate: '2017-12-31' + year: '2016' + tableFormat: 'html' + registryName: 'rapbase' + shinySession: list() +title: '`r paste(params$title, params$hospitalName, " i perioden fra ", params$startDate, " til ", params$endDate)`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%d\\. %B, %Y")`' +reglogo: '`r system.file("www/logoSmerte.png", package = "smerte")`' +regtext: '`r readLines(system.file("registryShortDescription.txt", package = "smerte"))`' +registryName: Smerteregisteret +userFullName: '`r params$userFullName`' +--- +```{r set options and load packages, include = FALSE} +knitr::opts_chunk$set(echo=FALSE) +options(knitr.table.format = params$tableFormat) +options(tinytex.verbose = TRUE) + +library(dplyr) +library(tidyverse) +library(zoo) +library(lubridate) +library(forcats) +library(stringr) +library(readr) +library(magrittr) +library(xtable) +library(kableExtra) +``` + +```{r setup, include=FALSE} +if (rapbase::isRapContext()) { + dat <- smerte::getRegDataOpiodReduksjon(registryName = params$registryName, + reshId = params$reshId, + userRole=params$userRole, + startDate = params$startDate, + endDate = params$endDate, + session = params$shinySession) +} else { + dat <- path <- read.csv(file = "H:/path.csv", header = FALSE, sep = ";") + path <- as.data.frame(lapply(path, as.character), stringsAsFactors=FALSE) + path <- path$V1 + dat <- read.csv(file = path, header = TRUE, sep = ";") +} +``` + +```{r yearSelect, include=FALSE} +#Hvis vi vil begrense +#dat <- dat[!(dat$MoEkvivalens22 > 10000),] + +#For å evaluere om data er tilstede +dataPresent <- TRUE +if(dim(dat)[1] < 1) { + dataPresent <- FALSE +} + +``` + + +```{r noData, eval=!dataPresent, results='asis'} +cat('# Upps...\nI den valgte tidsperioden er det ikke nok data til å gi + ut resultater.') +knitr::knit_exit() + +``` + +# Oversikt + +Denne oversikten viser resultater for et delmål i kvalitetsforbedringsprosjektet på ikke-medikamentell smertebehandling: Redusere bruk av opioider, målt ved perorale morfinekvivalenter ved siste tilsyn, med 10 % i 2022. + +Dersom et valgt år ikke vises er det ingen registreringer på morfinekvivalenter der. Merk at enkelte sykehus ikke har vært med alle årene. + +## Totalt + +```{r overall, include=FALSE} +#Gjennomsnittlig antall forløp + +d_moek = dat %>% filter(!is.na(MoEkvivalens22)) %>% + dplyr::group_by(year(StartdatoTO)) %>% + dplyr::summarise(nevner = n(), + ind = sum(MoEkvivalens22)/n()) +``` + +```{r taboverall, results='asis', echo = FALSE} + +rapbase::mst(tab = d_moek, + col_names = c("År", "Antall forløp", "Gj.snitt MoEkv"), + cap = paste0("Gjennomsnittlig mengde morfinekvivalenter per år"), + label = "moek", + type = "html", + digs = 1, + align = c("l", "r", "r", "r")) +``` + +## Per sykehus + +```{r sykehus, include=FALSE} +d_moek_syk = dat %>% filter(!is.na(MoEkvivalens22)) %>% + dplyr::group_by(year(StartdatoTO), SykehusNavn) %>% + dplyr::summarise(nevner = n(), ind = sum(MoEkvivalens22)/n()) +``` + +```{r tabsykehus, results='asis', echo = FALSE} +rapbase::mst(tab = d_moek_syk, + col_names = c("År", "Sykehus", "Antall forløp", "Gj.snitt MoEkv."), + cap = paste0("Gjennomsnittlig mengde morfinekvivalenter per sykehus og år"), + label = "moeksyk", + type = "html", + digs = 1, + align = c("l", "r", "r", "r", "r")) +``` diff --git a/inst/lokalEprom.Rmd b/inst/lokalEprom.Rmd index 3fcd64b..4a86f7f 100644 --- a/inst/lokalEprom.Rmd +++ b/inst/lokalEprom.Rmd @@ -99,17 +99,17 @@ I den valgte tidsperioden fikk tilsammen `r antUtsendt` pasienter av totalt `r d datpr <- dat[!is.na(dat$PasDelUfylPR), ] #Bruker her pakkene dplyr og magrittr pasreg <- datpr %>% - count(GrunnManglUtfyl) %>% + count(GrManglUtfylPR) %>% mutate(prosent = round(100*(n/sum(n)))) #Gi navn i stedet for tall til alternativene for tilsyn/ikke tilsyn pasreg = pasreg %>% - mutate(grunnPR = case_when(GrunnManglUtfyl == 1 ~ "Tidsmangel behandler", - GrunnManglUtfyl == 2 ~ "Tidlig utskrivning", - GrunnManglUtfyl == 3 ~ "Kritisk syk/død", - GrunnManglUtfyl == 4 ~ "Pasient klarer ikke", - GrunnManglUtfyl == 5 ~ "Manglende samtykke", - GrunnManglUtfyl == 7 ~ "Ikke besvart ePPROMS", - GrunnManglUtfyl == 9 ~ "Annet")) + mutate(grunnPR = case_when(GrManglUtfylPR == 1 ~ "Tidsmangel behandler", + GrManglUtfylPR == 2 ~ "Tidlig utskrivning", + GrManglUtfylPR == 3 ~ "Kritisk syk/død", + GrManglUtfylPR == 4 ~ "Pasient klarer ikke", + GrManglUtfylPR == 5 ~ "Manglende samtykke", + GrManglUtfylPR == 7 ~ "Ikke besvart ePPROMS", + GrManglUtfylPR == 9 ~ "Annet")) #Endrer rekkefølge og tar i tilleg ved NA-raden (siste) pasreg <- pasreg[1:(dim(pasreg)[1]-1), c(4,2,3)] diff --git a/inst/samlerapport.Rmd b/inst/samlerapport.Rmd deleted file mode 100644 index 1215a27..0000000 --- a/inst/samlerapport.Rmd +++ /dev/null @@ -1,46 +0,0 @@ ---- -title: "Samlerapport" -author: "Rapporteket" -date: '`r format(Sys.time(), "%d. %B %Y")`' -params: - var: "mpg" - bins: 5 -output: html_document ---- - -```{r setup, include=FALSE} -library(knitr) -library(kableExtra) -library(rapbase) -knitr::opts_chunk$set(echo = FALSE) -``` - - -## Samlerapport -Dette er eksempel på en samlerapport som er egnet til å kobinere presentasjon -av dynamisk tekst, tabeller og figurer. Samlerapporter kan vises i selve -Rapporeket, lastes ned eller sendes (rutinemessig) per epost til de som ønsker -det. - - -## Eksempel på dynamisk tekst -Idag, `r format(Sys.Date(), "%A %d. %b %Y")` er det -`r as.numeric(format(Sys.Date(), "%j"))` dager siden nyttår - - -## Eksempel på tabell -Tabellen under er kjedelig, men illustrerer poenget: - -```{r eksTab} -dt <- mtcars[1:6, ][params$var] -kable(dt) %>% - kable_styling(bootstrap_options = c("striped", "hover", "condensed")) -``` - - -## Eksempel på figur -Vi har sett den før, men tåler å få figuren på nytt: - -```{r eksFig, echo=FALSE} -f <- rapRegTemplate::makeHist(df = mtcars, var = params$var, bins = params$bins, makeTable = FALSE) -``` diff --git a/inst/shinyApps/smerte/server.R b/inst/shinyApps/smerte/server.R index 003471f..4932973 100644 --- a/inst/shinyApps/smerte/server.R +++ b/inst/shinyApps/smerte/server.R @@ -21,7 +21,8 @@ server <- function(input, output, session) { ## do not show local reports in national context if (smerte::isNationalReg(reshId)) { shiny::hideTab(inputId = "tabs", target = "Tilsyn") - shiny::hideTab(inputId = "tabs", target = "Dekningsgrad") + shiny::hideTab(inputId = "tabs", target = "Dekningsgrad før reservasjon") + shiny::hideTab(inputId = "tabs", target = "Dekningsgrad etter reservasjon") shiny::hideTab(inputId = "tabs", target = "Spinalkateter") shiny::hideTab(inputId = "tabs", target = "Smertekategori") } @@ -83,10 +84,14 @@ server <- function(input, output, session) { reportParams = reportParams ) - # Dekningsgrad + # Dekningsgrad gammel smerte::defaultReportServer(id = "dekningsgrad", reportFileName = "LokalDekningsgradrapport.Rmd", reportParams = reportParams) + # Dekningsgrad ny + smerte::defaultReportServer(id = "dekningsgradReserv", + reportFileName = "LokalDekningsgradrapportReservasjon.Rmd", + reportParams = reportParams) # Indikatorrapport reportTemplate <- "LokalIndikatorMaaned.Rmd" @@ -97,6 +102,16 @@ server <- function(input, output, session) { reportFileName = reportTemplate, reportParams = reportParams) + # Opiodreduksjon + reportTemplate2 <- "LokalOpioidReduksjon.Rmd" + if (smerte::isNationalReg(reshId)) { + reportTemplate2 <- "NasjonalOpioidReduksjon.Rmd" + } + smerte::defaultReportServer(id = "opioid", + reportFileName = reportTemplate2, + reportParams = reportParams) + + # eProm smerte::defaultReportServer(id = "eprom", reportFileName = "lokalEprom.Rmd", diff --git a/inst/shinyApps/smerte/ui.R b/inst/shinyApps/smerte/ui.R index a5115e2..889584e 100644 --- a/inst/shinyApps/smerte/ui.R +++ b/inst/shinyApps/smerte/ui.R @@ -36,16 +36,32 @@ ui <- shiny::tagList( ) ), shiny::tabPanel( - "Dekningsgrad", + "Dekningsgrad før reservasjon", shiny::sidebarLayout( shiny::sidebarPanel( - smerte::defaultReportInput("dekningsgrad") + smerte::defaultReportInput("dekningsgrad", + startDate = "2022-01-01", + endDate = "2022-11-30", + max = "2022-11-30") ), shiny::mainPanel( smerte::defaultReportUI("dekningsgrad") ) ) ), + shiny::tabPanel( + "Dekningsgrad etter reservasjon", + shiny::sidebarLayout( + shiny::sidebarPanel( + smerte::defaultReportInput("dekningsgradReserv", + startDate = "2022-12-01", + min = "2022-12-01") + ), + shiny::mainPanel( + smerte::defaultReportUI("dekningsgradReserv") + ) + ) + ), shiny::tabPanel( "Indikatorer", shiny::sidebarLayout( @@ -57,6 +73,17 @@ ui <- shiny::tagList( ) ) ), + shiny::tabPanel( + "Opioidreduksjon", + shiny::sidebarLayout( + shiny::sidebarPanel( + smerte::defaultReportInput("opioid") + ), + shiny::mainPanel( + smerte::defaultReportUI("opioid") + ) + ) + ), shiny::tabPanel( "Eprom", shiny::sidebarLayout( diff --git a/inst/veiledning.Rmd b/inst/veiledning.Rmd index 5b1b692..b090987 100644 --- a/inst/veiledning.Rmd +++ b/inst/veiledning.Rmd @@ -17,7 +17,9 @@ Her finnes rapportene det er mulig å hente ut fra rapporteket. Etter hvert som Tilsyn: informasjon om henvisninger, tilsyn (fordelt på lege, sykepleier etc.) og avdelingsoversikt for lokale data. -Dekningsgrad: utregning av dekningsgrad over valgfri tidsperiode for lokale data. +Dekningsgrad før reservasjon: utregning av dekningsgrad over valgfri tidsperiode for lokale data (gjelder før reservasjonsrett/til desember 2022). + +Dekningsgrad etter reservasjon: utregning av dekningsgrad over valgfri tidsperiode for lokale data (gjelder etter reservasjonsrett/fra desember 2022). Indikatorer: Smerteregisterets resultat - og kvalitetsindikatorer for lokale eller nasjonale data.