In Rapporteket/NORIC: Provide R Resources for NORIC at Rapporteket

library(magrittr)
library(knitr)
library(kableExtra)
library(dplyr)
library(stringr)
library(janitor)

# make sure to use a temporary directory AND absolute paths, e.g. that figs
# can be found also when deployed at a server. See below link for explanation
# https://rgriff23.github.io/2017/04/25/how-to-knit-for-mysite.html
# Also make sure we use tempdir() as working directory so we do not clutter
# the package of the hosting shiny app
# workDir <- tempdir()
# knitr::opts_knit$set(base.dir = workDir,
#                      base.url = file.path(paste0(tempdir(), "/")),
#                      root.dir = workDir)

# Handle both html and latex (pdf) output. Actually to avoid setting 'format'
# for each kable call
# inspired by https://stackoverflow.com/questions/46080853/why-does-rendering-a-pdf-from-rmarkdown-require-closing-rstudio-between-renders
options(knitr.table.format = params$tableFormat)

knitr::opts_chunk$set(warnings = FALSE, echo = FALSE)
options(stringsAsFactors = FALSE)

# For some reason Shiny Server does not get the server locale settings right.
# To display dates correct, enforce locale here:
Sys.setlocale("LC_TIME", "nb_NO.UTF-8")

colPrimary <- c("#000059",
                "#084594",
                "#2171b5",
                "#4292c6",
                "#6baed6",
                "#c6dbef")
colNeutral <- c("#4D4D4D", "#737373", "#A6A6A6", "#DADADA")
colKontrast <- "#FF7260"

showN <- 14

# DATAGRUNNLAG: PERIODE FOR SQL SPØRRING

# NYESTE DATO:
# Finne nyeste prosedyredato (=nyeste registrering). Vi ønsker ikke at
# forhåndsregisrerte planlagte forløp kommer med i rapporten. Derfor brukes
# gårsdagens dato som referanse, ingen forløp etter denne kommer med .
# Vi vil dermed også kunne se dersom ingen nye registreringer gjøres eller om
# overføringer har stoppet opp

# ELDSTE DATO:
# Januar fra i fjor (hele foregående år skal vise i rapporten)
nyeste_reg <- noric::getLatestEntry(registryName = params$registryName)

periode_data <- data.frame(
  siste_dato = min((as.Date(Sys.time()) - 1),
                   nyeste_reg))

periode_data %<>%
  dplyr::mutate(
    forste_dato  = lubridate::floor_date(.data$siste_dato,
                                         "month") - months(showN))

AP <- noric::getPrepApData(registryName = params$registryName,
                           fromDate  = periode_data$forste_dato,
                           toDate = periode_data$siste_dato,
                           singleRow = FALSE)

rangeProsDato <- format(range(AP$ProsedyreDato), 
                        format = "%d-%m-%Y")

AP %<>% mutate(
  Angiografor1 = ifelse(is.na(.data$Angiografor1),
                        "Ukjent",
                        .data$Angiografor1),

  PCIHovedOperator = ifelse(is.na(.data$PCIHovedOperator),
                            "Ukjent",
                            .data$PCIHovedOperator),

  forkortetNavnAngiografor = dplyr::if_else(
    .data$Angiografor1 %in% c("Ukjent"),
    true = .data$Angiografor1,
    false = paste0(
      substr(
        stringr::word(.data$Angiografor1, 1),
        1,
        1),
      ". ",
      stringr::word(.data$Angiografor1, -1)),
    missing = "Missing"),

  forkortetNavnPCIoperator = dplyr::if_else(
    .data$PCIHovedOperator %in% c("Ukjent"),
    true = .data$PCIHovedOperator,
    false = paste0(
      substr(
        stringr::word(.data$PCIHovedOperator, 1),
        1,
        1),
      ". ",
      stringr::word(.data$PCIHovedOperator, -1)),
    missing = "Missing")
)

r if(params$tableFormat !="html") {"<!--"}

Månedsrapport: Angiografør/Operatør {-}

Denne rapporten er generert ved hjelp av resultatløsningen Rapporteket og er kun ment til internt bruk!

Rapporten inneholder tabeller med resultater basert på forløp registrert ved r params$hospitalName. Opptellinger er gjort per forløp/prosedyre, og ikke per individ. Tabellene presenteres med data fra perioden r rangeProsDato[1] til r rangeProsDato[2].

Eventuelle spørsmål knyttet til rapporten kan rettes til [e-mail] r if(params$tableFormat !="html") {"-->"}

r if(params$tableFormat !="latex") {"<!--"} \newpage r if(params$tableFormat !="latex") {"-->"}

if (params$rendered_by_shiny == TRUE && params$tableFormat == "latex")
    shiny::setProgress(0.35)  # set progress to 35%

Angiografør

angiografor_AP <- AP %>% dplyr::filter(
  .data$ProsedyreType %in% c("Angio", "Angio + PCI"))

cap <- paste0("Antall prosedyrer registrert i NORIC hvor det er utført ",
              "koronar angiografi, per måned og navn på angiografør 1. ",
              "Gjelder for ", params$hospitalName, " i perioden ", 
              rangeProsDato[1], " til ", rangeProsDato[2], ". ",
              "Opptellingen er basert på prosedyretypene Angio og Angio+PCI.")

tab_angiografor <- angiografor_AP %>% 
  janitor::tabyl(forkortetNavnAngiografor,
                 maaned,
                 show_missing_levels = FALSE) %>% 
  janitor::adorn_totals("col", name = "Totalt") %>% 
  janitor::adorn_totals("row", name = "Totalt") %>% 
  dplyr::rename(" " = "forkortetNavnAngiografor")

tab_angiografor[tab_angiografor == 0] <- " - "
tab_angiografor[is.na(tab_angiografor)] <- " - "

align <- c("l", rep("c", dim(tab_angiografor)[2] - 1))

if (params$tableFormat == "html") {
  tab_angiografor %>% 
    knitr::kable(caption = cap,
               align = align) %>% 
    kableExtra::kable_styling(bootstrap_options = c("striped",
                                                    "hover",
                                                    "condensed"),
                              full_width = FALSE) %>%
    kableExtra::row_spec(row = 0, font_size = 10, angle = -45) %>%
    kableExtra::column_spec(column = 1, width = "7em")
} else if (params$tableFormat == "latex") {
  tab_angiografor %>%
  knitr::kable(format = params$tableFormat,
               caption = cap,
               booktabs = TRUE,
               align = align) %>%
    kableExtra::kable_styling(latex_options = c("HOLD_position",
                                                "scale_down")) %>%
    kableExtra::row_spec(row = 0, angle = 90)
}

if (params$rendered_by_shiny == TRUE && params$tableFormat == "latex")
    shiny::setProgress(0.7)  # set progress to 70%

r if(params$tableFormat !="latex") {"<!--"} \newpage r if(params$tableFormat !="latex") {"-->"}

PCI-operatør

pciOperator_AP <- AP %>% dplyr::filter(
  .data$ProsedyreType %in% c("Angio + PCI", "PCI"))

cap <- paste0("Antall prosedyrer registrert i NORIC hvor det er utført PCI, ",
              "per måned og navn på hovedoperatør. ",
              "Gjelder for ", params$hospitalName, " i perioden ",
              rangeProsDato[1], " til ", rangeProsDato[2], ". ",
              "Opptellingen er basert på prosedyretypene Angio+PCI og PCI.")

tab_pciOperator <- pciOperator_AP %>% 
  janitor::tabyl(forkortetNavnPCIoperator,
                 maaned,
                 show_missing_levels = FALSE) %>% 
  janitor::adorn_totals("col", name = "Totalt") %>% 
  janitor::adorn_totals("row", name = "Totalt") %>% 
  dplyr::rename(" " = "forkortetNavnPCIoperator")

tab_pciOperator[tab_pciOperator == 0] <- " - "
tab_pciOperator[is.na(tab_pciOperator)] <- " - "

align <- c("l", rep("c", dim(tab_pciOperator)[2] - 1))

if (params$tableFormat == "html") {
  tab_pciOperator %>% 
    knitr::kable(caption = cap,
               align = align) %>% 
    kableExtra::kable_styling(bootstrap_options = c("striped",
                                                    "hover",
                                                    "condensed"),
                              full_width = FALSE) %>%
    kableExtra::row_spec(row = 0, font_size = 10, angle = -45) %>%
    kableExtra::column_spec(column = 1, width = "7em")
} else if (params$tableFormat == "latex") {
  tab_pciOperator %>%
  knitr::kable(format = params$tableFormat,
               caption = cap,
               booktabs = TRUE,
               align = align) %>%
    kableExtra::kable_styling(latex_options = c("HOLD_position",
                                                "scale_down")) %>%
    kableExtra::row_spec(row = 0, angle = 90)
}

if (params$rendered_by_shiny == TRUE && params$tableFormat == "latex")
    shiny::setProgress(1)  # set progress to 100%

Rapporteket/NORIC documentation built on Sept. 7, 2024, 10:32 a.m.