Merge pull request #42 from Rapporteket/bugfix_falk

Bugfix falk
Rapporteket · Oct 16, 2023 · af728b2 · af728b2
2 parents 7a7c926 + 223dd2a
commit af728b2
Show file tree

Hide file tree

Showing 10 changed files with 104 additions and 33 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: ablanor
 Title: AblaNor- Rapporteket
-Version: 1.1.1
+Version: 1.2.0
 Authors@R: c(
   person(given = "Kristina",
            family = "Skaare",
@@ -20,7 +20,7 @@ License: GPL-3
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3
 Suggests: 
     testthat,
     withr

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,9 @@
+# ablanor 1.2.0
+Små justeringer på Rapporteket etter overgang til FALK som innloggings-
+portal i prod. 
+To nye reshid. 
+Bruker egendefinerte (finere) sykehusnavn i Rapporteket og i rapporter. 
+
 # ablanor 1.1.1
 
 * Installer Rapbase fra github i stedet for cran. Rapbase ble fjernet fra Cran i slutten av juni 2023 fordi en test feilet. Testen er fikset nå, men Rapbase er ikke publisert på nytt enda. Enn så lenge må pakken installeres direkte fra github.

diff --git a/R/app_server.R b/R/app_server.R
@@ -22,7 +22,10 @@ app_server <- function(input, output, session) {
   registryName <- "ablanor"
   mapOrgId <- ablanor::getNameReshId(registryName)
   reshId <- rapbase::getUserReshId(session)
-  hospitalName <- ablanor::getHospitalName(registryName, reshId)
+  hospitalName <- ablanor::getHospitalName(registryName = registryName,
+                                           reshId = reshId,
+                                           shortName = FALSE,
+                                           newNames = TRUE)
   userFullName <- rapbase::getUserFullName(session)
   userRole <- rapbase::getUserRole(session)
   userOperator <- "Test Operatoresen"
@@ -48,6 +51,8 @@ app_server <- function(input, output, session) {
   # Hide tabs when role 'SC'
   if (userRole == "SC") {
     shiny::hideTab(inputId = "tabs", target = "Månedsrapporter")
+    shiny::hideTab(inputId = "tabs", target = "Abonnement")
+
   }
 
 
@@ -314,16 +319,29 @@ app_server <- function(input, output, session) {
 
   # Values shared among subscriptions and dispatchment
   orgs <- ablanor::getNameReshId(registryName = registryName,
-                                 asNamedList = TRUE)
+                                 asNamedList = TRUE,
+                                 shortName = FALSE,
+                                 newNames = TRUE)
 
   # Abonnement
   subReports <- list(
     "Månedlige resultater" = list(
       synopsis = "Månedlige resultater sykehus/avdeling",
       fun = "reportProcessor",
-      paramNames = c("report", "outputType", "title", "orgId", "orgName"),
-      paramValues = c("local_monthly", "pdf", "Månedsresultater", reshId,
-                      hospitalName)
+      paramNames = c("report",
+                     "outputType",
+                     "title",
+                     "orgId",
+                     "orgName",
+                     "userFullName",
+                     "userRole"),
+      paramValues = c("local_monthly",
+                      "pdf",
+                      "Månedsresultater",
+                      reshId,
+                      hospitalName,
+                      userFullName,
+                      userRole)
     )
   )
 
@@ -337,8 +355,16 @@ app_server <- function(input, output, session) {
     "Månedlige resultater" = list(
       synopsis = "AblaNor månedlige resultater sykehus/avdeling",
       fun = "reportProcessor",
-      paramNames = c("report", "outputType", "title", "orgId"),
-      paramValues = c("local_monthly", "pdf", "Månedsresultater", 999999)
+      paramNames = c("report",
+                     "outputType",
+                     "title",
+                     "orgId",
+                     "userFullName"),
+      paramValues = c("local_monthly",
+                      "pdf",
+                      "Månedsresultater",
+                      999999,
+                      userFullName)
     )
   )
 

diff --git a/R/getData.R b/R/getData.R
@@ -26,6 +26,9 @@
 #' to local data (defined by \code{reshId}), "SC" has access to national data.
 #' @param shortName boolean. Default value FALSE and "friendlyname" is returned.
 #' If TRUE shortname is returned.
+#' @param newNames boolean. TRUE uses "sykehusnavn" as defined in
+#' 'legg_til_sykehusnavn()'. Default value is FALSE, uses "sykehusnavn" from
+#' table Friendlycentre.
 #' @param ... Optional arguments to be passed to the function.
 #'
 #' @return Data frame or (when multiple data sets are returned) a list of data
@@ -116,7 +119,7 @@ getDataDump <- function(registryName, tableName, fromDate, toDate,
 
 #' @rdname getData
 #' @export
-getNameReshId <- function(registryName, asNamedList = FALSE) {
+getNameReshId <- function(registryName, asNamedList = FALSE, shortNames = FALSE, newNames = FALSE) {
 
   query <- "
 SELECT
@@ -132,6 +135,15 @@ GROUP BY
 
   res <- rapbase::loadRegData(registryName, query)
 
+  if(newNames){
+    res %<>%
+      dplyr::mutate(centreid = id) %>%
+      ablanor::legg_til_sykehusnavn(., short = shortNames) %>%
+      dplyr::select(id, sykehusnavn) %>%
+      dplyr::rename("name" = "sykehusnavn") %>%
+      dplyr::filter(!is.na(name))
+  }
+
   if (asNamedList) {
     res <- stats::setNames(res$id, res$name)
     res <- as.list(res)
@@ -142,7 +154,7 @@ GROUP BY
 
 #' @rdname getData
 #' @export
-getHospitalName <- function(registryName, reshId, shortName = FALSE) {
+getHospitalName <- function(registryName, reshId, shortName = FALSE, newNames = FALSE) {
 
   if (shortName) {
     dbField <- "CENTRESHORTNAME"
@@ -158,7 +170,15 @@ FROM
 WHERE
   ID = ", reshId, ";")
 
-  name <- rapbase::loadRegData(registryName, query)[1, ]
+  if(newNames) {
+    name <- ablanor::legg_til_sykehusnavn(
+        df = data.frame(centreid = reshId),
+        short = shortName) %>%
+      dplyr::pull(sykehusnavn)
+    } else {
+      name <- rapbase::loadRegData(registryName, query)[1, ]
+    }
+
 
   if (is.na(name)) {
     warning(paste("Resh ID", reshId, "did not match any names!"))

diff --git a/R/legg_til_sykehusnavn.R b/R/legg_til_sykehusnavn.R
@@ -12,7 +12,7 @@
 #'
 #' @export
 #' @examples
-#' df <- data.frame(centreid = c(102966, 104284, 4214492, 700328, 700728))
+#' df <- data.frame(centreid = c(102966, 104284, 4214492, 700328, 4219765))
 #' ablanor::legg_til_sykehusnavn(df = df, short = TRUE)
 legg_til_sykehusnavn <- function(df, short = TRUE) {
 
@@ -23,18 +23,18 @@ legg_til_sykehusnavn <- function(df, short = TRUE) {
     df %>% dplyr::mutate(
       sykehusnavn = dplyr::case_when(centreid == 102966 ~ "HUS",
                                      centreid == 104284 ~ "St.Olavs",
-                                     centreid == 4214492 ~ "AHus",
+                                     centreid == 4218359 ~ "AHus",
                                      centreid == 700328 ~ "OUS",
-                                     centreid == 700728 ~ "UNN",
+                                     centreid == 4219765 ~ "UNN",
                                      TRUE ~ NA_character_))
   } else {
     df %>% dplyr::mutate(
       sykehusnavn = dplyr::case_when(
         centreid == 102966 ~ "Haukeland Universitetssykehus",
         centreid == 104284 ~ "St.Olavs Hospital",
-        centreid == 4214492 ~ "AHus Gardermoen",
+        centreid == 4218359 ~ "AHus Gardermoen",
         centreid == 700328 ~ "Oslo Universitetssykehus",
-        centreid == 700728 ~ "Universitetssykehuset Nord-Norge",
+        centreid == 4219765 ~ "Universitetssykehuset Nord-Norge",
         TRUE ~ NA_character_))
   }
 }
diff --git a/R/reportProcessor.R b/R/reportProcessor.R
@@ -80,12 +80,16 @@ reportProcessor <- function(report,
       outputType = outputType,
       params = list(
         author = author,
-        hospitalName = ablanor::getHospitalName("ablanor", orgId),
+        hospitalName = ablanor::getHospitalName(registryName = "ablanor",
+                                                reshId = orgId,
+                                                newNames = TRUE,
+                                                shortName = FALSE),
         tableFormat = outputType,
         reshId = orgId,
         registryName = registryName,
         userRole = userRole,
-        userOperator = userOperator
+        userOperator = userOperator,
+        userFullName = userFullName
       )
     )
   }

diff --git a/inst/AblaNor_local_monthly.Rmd b/inst/AblaNor_local_monthly.Rmd
@@ -55,6 +55,12 @@ colKontrast <- "#FF7260"
 
 ```{r parametre}
 showN <- 12
+
+#Egendefinerte kortnavn:
+hospitalNameShort <- ablanor::getHospitalName(registryName = "ablanor",
+                                              reshId = params$reshId, 
+                                              shortName = TRUE,
+                                              newNames = TRUE)
 ```
 
 
@@ -130,7 +136,7 @@ siste `r showN`  månedene: det vil si i intervallet fra  `r format(periode_data
 `r format(periode_data$siste_dato, "%d/%m-%Y")`. 
 
 
-Første og siste registrering fra `r params$hospitalName` i tidsperioden er
+Første og siste registrering fra `r hospitalNameShort` i tidsperioden er
 henholdsvis `r format(periode_data$forste_dato_shus, "%d/%m-%Y") ` og
 `r format(periode_data$nyeste_dato_shus, "%d/%m-%Y") `. 
 
@@ -147,14 +153,14 @@ Elektrofysiologisk undersøkelse (EFU). Dersom forløpstype ikke er registrert
 blir verdien NA (not available), dette gjelder forløp der prosedyreskjema ikke
 er ferdigstilte. 
 Tabellen under (Tabell \@ref(tab:typeForlopAar)) viser antall forløp
-registrert i AblaNor fra `r params$hospitalName` de `r showN` siste månedene, 
+registrert i AblaNor fra `r hospitalNameShort` de `r showN` siste månedene, 
 for hver forløpstype og sammenlagt. 
 Figur \@ref(fig:typeForlopFig) viser antall forløp per
 måned, samt fordeling etter forløpstype. 
 
 ```{r typeForlopAar}
 cap <- paste("Totalt antall forløp fra ", 
-             params$hospitalName, " de ", showN, " siste månedene.",
+             hospitalNameShort, " de ", showN, " siste månedene.",
              "For hver av de 4 forløpstypene: ",
              "Atrieflimmer/atypisk flutter (AFLI), Ventrikkeltakykardi (VT), ", 
              "Supraventrikulær takykardi (SVT) eller ", 
@@ -180,7 +186,7 @@ d_ablanor %>%
 ```{r typeForlopFig, fig.cap = figtekst, fig.pos = "H", fig.align = "center", out.width = "100%", fig.asp = 0.8 }
 
 figtekst <- paste0("Antall registreringer i AblaNor fra ", 
-                   params$hospitalName, " hver måned det siste året. ", 
+                   hospitalNameShort, " hver måned det siste året. ", 
                    "Tallene i søylene viser antall registrerte forløp per ", 
                    "forløpstype. ", 
                    "Atrieflimmer/atypisk flutter (AFLI), ", 
@@ -215,7 +221,7 @@ ggplot2::ggplot(
   ablanor::ablanor_plot_theme() + 
   ggplot2::labs(title = paste0("Antall registreringer i AblaNor de ",
                                showN, " siste månedene" ),
-                subtitle = params$hospitalName) +
+                subtitle = hospitalNameShort) +
   ggplot2::geom_vline(xintercept = 0, size = 1, colour = "gray45") +
   ggplot2::geom_text(
     ggplot2::aes(label = .data$n_uten0),
@@ -249,7 +255,7 @@ totalt per måned og i underpopulasjoner per måned.
 
 
 ```{r komplikasjonerFig, fig.cap = figtekst, fig.pos = "H", fig.align = "center", out.width = "100%", fig.asp = 0.8 }
-figtekst <- paste0("Andel forløp fra ", params$hospitalName, 
+figtekst <- paste0("Andel forløp fra ", hospitalNameShort, 
                    " med komplikasjoner det siste året. " ,
                    "Tallene i søylene viser antall forløp med ", 
                    "komplikasjoner delt på totalt antall forløp per måned.")
@@ -279,7 +285,7 @@ ggplot2::ggplot(data = d_kompl_fig2,
   ggplot2::geom_bar(stat = "identity", position = "identity",  fill = colPrimary[4]) +
   ggplot2::labs(title = paste0("Komplikasjoner de ",
                                showN, " siste månedene"), 
-                subtitle = params$hospitalName) +
+                subtitle = hospitalNameShort) +
   ablanor::ablanor_plot_theme() +
   ggplot2::geom_vline(xintercept = 0, size = 1, colour = "gray45") +
   ggplot2::geom_text(ggplot2::aes(label = komp_text), 
@@ -448,7 +454,7 @@ ggplot2::ggplot(data = d_akutt_suksess_fig2,
                       linetype = "dashed") +
   ggplot2::labs(title = paste0("Akutt suksess de ",
                                showN, " siste månedene"), 
-                subtitle = params$hospitalName) +
+                subtitle = hospitalNameShort) +
   ggplot2::scale_x_continuous(labels = function(x) paste0(x * 100, "%")) 
 
 ```
@@ -678,7 +684,7 @@ d_ablanor %>%
   ggplot2::scale_y_discrete(drop = FALSE) + 
   ggplot2::labs(title = paste0("Prosedyrevarighet (minutter) de ",
                                showN, " siste månedene"), 
-                subtitle = params$hospitalName) 
+                subtitle = hospitalNameShort) 
 
 ```
 
@@ -930,7 +936,7 @@ d_varighet_tot_maaned %>%
   ggplot2::scale_y_discrete(drop = FALSE) + 
   ggplot2::labs(title = paste0("Røntgenvarighet (minutter) de ",
                                showN, " siste månedene"), 
-                subtitle = params$hospitalName) 
+                subtitle = hospitalNameShort) 
 
 ```
 

diff --git a/man/getData.Rd b/man/getData.Rd
diff --git a/man/legg_til_sykehusnavn.Rd b/man/legg_til_sykehusnavn.Rd
diff --git a/tests/testthat/test-legg_til_sykehusnavn.R b/tests/testthat/test-legg_til_sykehusnavn.R
@@ -1,6 +1,6 @@
 test_that("legg til sykehusnavn works", {
 
-  df <- data.frame(centreid = c(102966, 104284, 4214492, 700328, 700728,
+  df <- data.frame(centreid = c(102966, 104284, 4218359, 700328, 4219765,
                                 NA, 123456))