klar for ny prodsetting

NAMESPACE

@@ -19,6 +19,7 @@ export(getRegDataRapportDekningsgradReservasjon)
 export(getRegDataRapportOppfolg)
 export(getRegDataSmertekategori)
 export(getRegDataSpinalkateter)
+export(getRegDataLokalEpidural)
 export(getSmerteDiagKatValueLab)
 export(isNationalReg)
 export(isOUSReg)

R/GetRegData.R

@@ -386,6 +386,38 @@ WHERE
   rapbase::loadRegData(registryName, query, dbType)
 }
 
+#' @rdname getRegData
+#' @export
+getRegDataLokalEpidural <- function(registryName, reshId, userRole,
+                                          startDate, endDate, ...) {
+  dbType <- "mysql"
+
+  deps <- .getDeps(reshId, userRole)
+
+  query <- "
+SELECT
+  PasientID,
+  ForlopsID,
+  alder,
+  EDAB11,
+  EDA,
+  StartdatoTO
+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
 getRegDataRapportOppfolg <- function(registryName, reshId, userRole,

inst/LokalDekningsgradrapportReservasjon.Rmd

@@ -102,7 +102,7 @@ if (dim(dat)[1] < 1) {
     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.")
+                      " registrert med reservasjon, mens det totalt er ", antReservTOT, " forløp med reservasjon. Det er totalt ", nNoIncl, " forløp som ikke oppfyller inklusjonskriteriene.")
   }
   
 }

inst/LokalEpidural.Rmd

@@ -0,0 +1,113 @@
+---
+params:
+  title: ': Epiduraler for barn under 18 år '
+  author: 'Rapporteket'
+  hospitalName: 'Ukjent sykehus'
+  reshId: 'locallyDefined'
+  userRole: 'MyRole'
+  userFullName: 'Ukjent bruker'
+  startDate: !r lubridate::today() - lubridate::years(1)
+  endDate: !r lubridate::today() - lubridate::weeks(1)
+  year: '2016'
+  tableFormat: 'html'
+  registryName: 'rapbase'
+  shinySession: list()
+title: '`r paste0("Smerteregisteret ", params$hospitalName, params$title, 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)
+options(scipen = 1, digits = 2) #set to two decimal 
+
+library(ggplot2)
+library(tidyverse)
+library(dplyr)
+library(zoo)
+
+```
+
+```{r get data, warning = FALSE, message=TRUE}
+
+if (rapbase::isRapContext()) {
+  dat <- smerte::getRegDataLokalEpidural(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 = ";")
+}
+
+#Forkorter sykehusnavn
+#dat$SykehusNavn[dat$SykehusNavn == "Helse Bergen HF"] = "HB"
+
+#Legger inn månedene i riktig rekkefølge
+dat <- dat %>%
+  dplyr::mutate(monthname = zoo::as.Date(zoo::as.yearmon(StartdatoTO)))
+
+#Tar bare med barn (< 18 år)
+bdat <- dat[dat$alder < 18, ]
+
+```
+
+# Oversikt: epidural for pasienter under 18 år
+
+Denne rapporten gir en oversikt over antall barn som har fått epidural under innleggelse på sykehuset. Merk at det ses på forløp, slik at en pasient kan være representert flere ganger.
+
+## Resultater
+```{r lagdata, warning = FALSE, message=FALSE, results='asis'}
+messageepi<- ""
+
+# Klargjøre
+if (dim(bdat)[1] < 1) {
+  messageepi <- "I den valgte tidsperioden er det ikke nok data til å gi ut resultater."
+  antepi <- 0
+  } else {
+    #Verdier som skal vises i tabell for denne indikatoren
+    antepi <- sum(bdat$EDA == 1, na.rm = TRUE)
+    }
+```
+`r messageepi`
+I den valgte tidsperioden fikk tilsammen `r antepi` av totalt `r dim(bdat)[1]` pasienter under 18 år epidural.
+
+
+Figuren under viser hvordan aldersfordelingen er blant disse.
+
+```{r epibarnfig, warning = FALSE, message=FALSE, results='asis', fig.pos= "H", out.extra = '', fig.align='center', out.width='100%'}
+
+messageplot <- ""
+
+if (dim(bdat)[1] < 1) {
+  messageplot <- "I den valgte tidsperioden er det ikke nok data til å vise figuren."
+} else {
+  
+  #Kun de som har fått epidural
+  plotdat <- bdat %>%
+    filter(EDA == 1)
+  
+  #Lager histogram fordelt på alder
+p <- ggplot(plotdat, aes(x = alder)) + 
+  geom_histogram(color = "darkblue", fill = "lightblue") +
+  labs(x = "Alder (år)", y = "Antall", subtitle = "Aldersfordeling hos barn som fikk epidural.") +   scale_x_continuous(breaks = c(0:100000)) + #obs for å fine ticks, går det greit?
+  scale_y_continuous(breaks = c(0:17)) +
+  theme(axis.text.x=element_text(size=14),
+        axis.text.y=element_text(size=14),
+        axis.title.x = element_text(size = 15),
+        axis.title.y = element_text(size = 15),
+        plot.subtitle = element_text(size = 17))
+p
+}
+```
+`r messageplot`