From 7826cccbac1d5755c7d390da5a76c32e4a764829 Mon Sep 17 00:00:00 2001 From: kevinthon Date: Wed, 22 Jan 2025 14:23:58 +0100 Subject: [PATCH] ny testversjon med oppdatert rapbase --- DESCRIPTION | 2 +- Dockerfile | 2 +- R/modul_admtab.R | 246 +++++++++++++++++++++++----------------- R/modul_fordelingsfig.R | 130 +++++++++++++-------- 4 files changed, 228 insertions(+), 152 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4572b6c..fb0c17a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: norgast Type: Package Title: Resultatrapporter for NORGAST -Version: 3.0.14 +Version: 3.0.15 Date: 2015-12-17 Author: Kevin Thon Maintainer: Kevin Thon diff --git a/Dockerfile b/Dockerfile index 5c64ca1..3a3f2f7 100644 --- a/Dockerfile +++ b/Dockerfile @@ -9,7 +9,7 @@ COPY *.tar.gz . RUN R -e "remotes::install_local(list.files(pattern = \"*.tar.gz\"))" \ && rm ./*.tar.gz \ - && R -e "remotes::install_github(\"Rapporteket/rapbase\", ref = \"main\")" + && R -e "remotes::install_github(\"Rapporteket/rapbase\", ref = \"deaktiver_log_autoreport\")" EXPOSE 3838 diff --git a/R/modul_admtab.R b/R/modul_admtab.R index 7bed6f1..e139d01 100644 --- a/R/modul_admtab.R +++ b/R/modul_admtab.R @@ -14,13 +14,15 @@ admtab_ui <- function(id){ id = ns("id_adm_panel"), div( id = ns("fane1"), - dateRangeInput(inputId=ns("datovalg_adm"), label = "Dato fra og til", - min = '2014-01-01', language = "nb", - max = Sys.Date(), - start = lubridate::floor_date(lubridate::today() - - lubridate::years(1), - unit = "year"), - end = Sys.Date(), separator = " til ") + dateRangeInput( + inputId=ns("datovalg_adm"), + label = "Dato fra og til", + min = '2014-01-01', language = "nb", + max = Sys.Date(), + start = lubridate::floor_date(lubridate::today() - + lubridate::years(1), + unit = "year"), + end = Sys.Date(), separator = " til ") ), shinyjs::hidden(selectInput(inputId = ns("adm_tidsenhet"), label = "Velg tidsenhet", @@ -53,9 +55,6 @@ admtab_ui <- function(id){ basisregistrering og oppfølging.'), h4(tags$b('Oppfølging i kladd '), 'viser antall forløp med ferdigstilt basisregistrering og oppfølging i kladd.'), - # h4(tags$b('Ferdig basisreg. oppfølging mangler '), 'viser antall forløp - # med ferdigstilt basisregistrering og ikke påbegynt eller slettet - # oppfølging'), h4(tags$b('Basisreg. i kladd '), 'viser antallet basisregistreringer i kladd.'), br(), @@ -73,7 +72,8 @@ admtab_ui <- function(id){ ) } -#' Serverdel av modul for Administrative tabeller-fane i NORGAST sin shiny-app på Rapporteket +#' Serverdel av modul for Administrative tabeller-fane i NORGAST sin shiny-app +#' på Rapporteket #' #' Kun til bruk i Shiny #' @@ -90,38 +90,38 @@ admtab_server <- function(id, RegData, userRole, shinyjs::reset("id_adm_panel") }) - observe( - if (userRole() != 'SC') { - shinyjs::hide(id = 'valgtShus_ui') - }) - output$op_gruppe_ui <- renderUI({ ns <- session$ns - selectInput(inputId = ns("op_gruppe"), label = "Velg reseksjonsgruppe(r)", - choices = BrValg$reseksjonsgrupper, multiple = TRUE) + selectInput(inputId = ns("op_gruppe"), + label = "Velg reseksjonsgruppe(r)", + choices = BrValg$reseksjonsgrupper, + multiple = TRUE) }) output$valgtShus_ui <- renderUI({ ns <- session$ns - selectInput(inputId = ns("valgtShus"), label = "Velg sykehus", - choices = BrValg$sykehus, multiple = TRUE) + if (userRole() == 'SC') { + selectInput(inputId = ns("valgtShus"), label = "Velg sykehus", + choices = BrValg$sykehus, multiple = TRUE) + } }) output$ncsp <- renderUI({ ns <- session$ns if (!is.null(input$op_gruppe)) { - selectInput(inputId = ns("ncsp_verdi"), - label = "NCSP koder (velg en eller flere)", - choices = if (!is.null(input$op_gruppe)) { - RegData %>% - dplyr::select(Hovedoperasjon, Op_gr) %>% - dplyr::filter(Op_gr %in% as.numeric(input$op_gruppe)) %>% - dplyr::select(Hovedoperasjon) %>% - unique() %>% - dplyr::arrange(Hovedoperasjon) %>% - dplyr::mutate(NCSP = substr(Hovedoperasjon, 1, 5)) %>% - dplyr::pull(NCSP, Hovedoperasjon) - }, multiple = TRUE) + selectInput( + inputId = ns("ncsp_verdi"), + label = "NCSP koder (velg en eller flere)", + choices = if (!is.null(input$op_gruppe)) { + RegData %>% + dplyr::select(Hovedoperasjon, Op_gr) %>% + dplyr::filter(Op_gr %in% as.numeric(input$op_gruppe)) %>% + dplyr::select(Hovedoperasjon) %>% + unique() %>% + dplyr::arrange(Hovedoperasjon) %>% + dplyr::mutate(NCSP = substr(Hovedoperasjon, 1, 5)) %>% + dplyr::pull(NCSP, Hovedoperasjon) + }, multiple = TRUE) } }) @@ -177,55 +177,62 @@ admtab_server <- function(id, RegData, userRole, antskjema <- function() { # req(input$admtabeller == "id_ant_skjema") - tmp <- merge(skjemaoversikt[skjemaoversikt$Skjemanavn=='Registrering', - c("ForlopsID", "SkjemaStatus", "HovedDato", - "OpprettetDato", "Sykehusnavn", "AvdRESH", - "Op_gr", "Hovedoperasjon")], - skjemaoversikt[skjemaoversikt$Skjemanavn=='Reinnleggelse/oppføl', - c("ForlopsID", "SkjemaStatus")], - by = 'ForlopsID', all.x = T, suffixes = c('', '_oppf')) + tmp <- merge( + skjemaoversikt[skjemaoversikt$Skjemanavn=='Registrering', + c("ForlopsID", "SkjemaStatus", "HovedDato", + "OpprettetDato", "Sykehusnavn", "AvdRESH", + "Op_gr", "Hovedoperasjon")], + skjemaoversikt[skjemaoversikt$Skjemanavn=='Reinnleggelse/oppføl', + c("ForlopsID", "SkjemaStatus")], + by = 'ForlopsID', all.x = T, suffixes = c('', '_oppf')) if (input$kun_oblig) { - # tmp <- tmp[tmp$ForlopsID %in% RegData$ForlopsID[RegData$Op_gr %in% 1:7], ] tmp <- tmp[tmp$Op_gr %in% 1:8, ] } tmp$SkjemaStatus[tmp$SkjemaStatus==-1] <- 0 tmp$SkjemaStatus_oppf[tmp$SkjemaStatus_oppf==-1] <- 0 - tmp$HovedDato[is.na(tmp$HovedDato)] <- tmp$OpprettetDato[is.na(tmp$HovedDato)] - # tmp <- merge(tmp, RegData[,c("ForlopsID", "Op_gr", "Hovedoperasjon")], by = "ForlopsID", all.x = T) - if (!is.null(input$op_gruppe)) {tmp <- tmp[which(tmp$Op_gr %in% as.numeric(input$op_gruppe)), ]} - if (!is.null(input$ncsp_verdi)) {tmp <- tmp[which(substr(tmp$Hovedoperasjon, 1, 5) %in% input$ncsp_verdi), ]} - if (!is.null(input$valgtShus)) {tmp <- tmp[tmp$AvdRESH %in% as.numeric(input$valgtShus), ]} + tmp$HovedDato[is.na(tmp$HovedDato)] <- + tmp$OpprettetDato[is.na(tmp$HovedDato)] + if (!is.null(input$op_gruppe)) { + tmp <- tmp[which(tmp$Op_gr %in% as.numeric(input$op_gruppe)), ]} + if (!is.null(input$ncsp_verdi)) { + tmp <- tmp[which(substr(tmp$Hovedoperasjon, 1, 5) %in% + input$ncsp_verdi), ]} + if (!is.null(input$valgtShus) & userRole() == "SC") { + tmp <- tmp[tmp$AvdRESH %in% as.numeric(input$valgtShus), ]} aux <- tmp %>% dplyr::filter(HovedDato >= input$datovalg_adm[1] & HovedDato <= input$datovalg_adm[2]) %>% dplyr::group_by(Sykehusnavn) %>% dplyr::summarise( - 'Ferdige forløp' = sum(SkjemaStatus==1 & - (SkjemaStatus_oppf==1 | is.na(SkjemaStatus_oppf)), na.rm = T), + 'Ferdige forløp' = sum( + SkjemaStatus==1 & + (SkjemaStatus_oppf==1 | is.na(SkjemaStatus_oppf)), na.rm = T), 'Oppfølging i kladd' = sum(SkjemaStatus==1 & SkjemaStatus_oppf==0, na.rm = T), - # 'Ferdig basisreg. oppfølging mangler' = sum(SkjemaStatus==1 & - # is.na(SkjemaStatus_oppf), na.rm = T), 'Basisreg i kladd' = sum(SkjemaStatus==0, na.rm = T), 'N' = dplyr::n()) aux2 <- tmp %>% dplyr::filter(HovedDato >= input$datovalg_adm[1] & HovedDato <= input$datovalg_adm[2]) %>% dplyr::summarise( - 'Ferdige forløp' = sum(SkjemaStatus==1 & (SkjemaStatus_oppf==1 | is.na(SkjemaStatus_oppf)), na.rm = T), - 'Oppfølging i kladd' = sum(SkjemaStatus==1 & SkjemaStatus_oppf==0, na.rm = T), - # 'Ferdig basisreg. oppfølging mangler' = sum(SkjemaStatus==1 & is.na(SkjemaStatus_oppf), na.rm = T), + 'Ferdige forløp' = sum( + SkjemaStatus==1 & (SkjemaStatus_oppf==1 | + is.na(SkjemaStatus_oppf)), na.rm = T), + 'Oppfølging i kladd' = sum(SkjemaStatus==1 & + SkjemaStatus_oppf==0, na.rm = T), 'Basisreg i kladd' = sum(SkjemaStatus==0, na.rm = T), 'N' = dplyr::n()) - ant_skjema <- dplyr::bind_rows(aux, dplyr::bind_cols(dplyr::tibble(Sykehusnavn='Totalt'), aux2)) + ant_skjema <- dplyr::bind_rows( + aux, dplyr::bind_cols(dplyr::tibble(Sykehusnavn='Totalt'), aux2)) sketch <- htmltools::withTags(table( DT::tableHeader(ant_skjema[-dim(ant_skjema)[1], ]), - DT::tableFooter(c('Sum' , as.numeric(ant_skjema[dim(ant_skjema)[1], 2:dim(ant_skjema)[2]]))))) + DT::tableFooter(c('Sum' , as.numeric( + ant_skjema[dim(ant_skjema)[1], 2:dim(ant_skjema)[2]]))))) list(ant_skjema=ant_skjema, sketch=sketch) @@ -258,15 +265,17 @@ admtab_server <- function(id, RegData, userRole, tilDato <- as.Date(paste0(input$datovalg_adm_tid_mnd)) # fraDato <- tilDato %m-% months(as.numeric(input$ant_mnd)) %>% # lubridate::floor_date(unit="months") - fraDato <- lubridate::`%m-%`(tilDato, months(as.numeric(input$ant_mnd))) %>% + fraDato <- lubridate::`%m-%`(tilDato, + months(as.numeric(input$ant_mnd))) %>% lubridate::floor_date(unit="months") - tmp <- merge(skjemaoversikt[skjemaoversikt$Skjemanavn=='Registrering', - c("ForlopsID", "SkjemaStatus", "HovedDato", - "OpprettetDato", "Sykehusnavn", "AvdRESH", - "Op_gr", "Hovedoperasjon")], - skjemaoversikt[skjemaoversikt$Skjemanavn=='Reinnleggelse/oppføl', - c("ForlopsID", "SkjemaStatus")], - by = 'ForlopsID', all.x = T, suffixes = c('', '_oppf')) + tmp <- merge( + skjemaoversikt[skjemaoversikt$Skjemanavn=='Registrering', + c("ForlopsID", "SkjemaStatus", "HovedDato", + "OpprettetDato", "Sykehusnavn", "AvdRESH", + "Op_gr", "Hovedoperasjon")], + skjemaoversikt[skjemaoversikt$Skjemanavn=='Reinnleggelse/oppføl', + c("ForlopsID", "SkjemaStatus")], + by = 'ForlopsID', all.x = T, suffixes = c('', '_oppf')) if (input$kun_oblig) { tmp <- tmp[tmp$Op_gr %in% 1:8, ] @@ -274,93 +283,124 @@ admtab_server <- function(id, RegData, userRole, tmp$SkjemaStatus[tmp$SkjemaStatus==-1] <- 0 tmp$SkjemaStatus_oppf[tmp$SkjemaStatus_oppf==-1] <- 0 - tmp$HovedDato[is.na(tmp$HovedDato)] <- as.Date(tmp$OpprettetDato[is.na(tmp$HovedDato)]) - if (!is.null(input$op_gruppe)) {tmp <- tmp[which(tmp$Op_gr %in% as.numeric(input$op_gruppe)), ]} - if (!is.null(input$ncsp_verdi)) {tmp <- tmp[which(substr(tmp$Hovedoperasjon, 1, 5) %in% input$ncsp_verdi), ]} - if (!is.null(input$valgtShus)) {tmp <- tmp[tmp$AvdRESH %in% as.numeric(input$valgtShus), ]} + tmp$HovedDato[is.na(tmp$HovedDato)] <- + as.Date(tmp$OpprettetDato[is.na(tmp$HovedDato)]) + if (!is.null(input$op_gruppe)) { + tmp <- tmp[which(tmp$Op_gr %in% as.numeric(input$op_gruppe)), ]} + if (!is.null(input$ncsp_verdi)) { + tmp <- tmp[which(substr(tmp$Hovedoperasjon, 1, 5) %in% + input$ncsp_verdi), ]} + if (!is.null(input$valgtShus) & userRole() == "SC") { + tmp <- tmp[tmp$AvdRESH %in% as.numeric(input$valgtShus), ]} aux <- tmp - aux$mnd <- factor(format(aux$HovedDato, format='%b-%y'), levels = format(seq(fraDato, tilDato, by="month"), "%b-%y")) + aux$mnd <- factor(format(aux$HovedDato, format='%b-%y'), + levels = format(seq(fraDato, tilDato, by="month"), + "%b-%y")) ant_skjema <- switch ( req(input$regstatus_tid), '1' = as.data.frame.matrix( addmargins( - table(aux[which(aux$SkjemaStatus==1 & (aux$SkjemaStatus_oppf==1 | - is.na(aux$SkjemaStatus_oppf))) , + table(aux[which(aux$SkjemaStatus==1 & + (aux$SkjemaStatus_oppf==1 | + is.na(aux$SkjemaStatus_oppf))) , c('Sykehusnavn', 'mnd')]))), '2' = as.data.frame.matrix( addmargins( - table(aux[which(aux$SkjemaStatus==1 & aux$SkjemaStatus_oppf==0) , + table(aux[which(aux$SkjemaStatus==1 & + aux$SkjemaStatus_oppf==0), c('Sykehusnavn', 'mnd')]))), '3' = as.data.frame.matrix( addmargins( - table(aux[which(aux$SkjemaStatus==1 & is.na(aux$SkjemaStatus_oppf)) , + table(aux[which(aux$SkjemaStatus==1 & + is.na(aux$SkjemaStatus_oppf)), c('Sykehusnavn', 'mnd')]))), '4' = as.data.frame.matrix( addmargins( - table(aux[which(aux$SkjemaStatus==0) , c('Sykehusnavn', 'mnd')]))) + table(aux[which(aux$SkjemaStatus==0) , + c('Sykehusnavn', 'mnd')]))) ) %>% dplyr::as_tibble(rownames = 'Sykehusnavn') } if (input$adm_tidsenhet == 2) { req(input$datovalg_adm_tid_aar) tilDato <- as.Date(input$datovalg_adm_tid_aar) - fraDato <- lubridate::`%m-%`(tilDato, lubridate::years(input$ant_aar)) %>% lubridate::floor_date(unit="years") - tmp <- merge(skjemaoversikt[skjemaoversikt$Skjemanavn=='Registrering', c("ForlopsID", "SkjemaStatus", "HovedDato", - "OpprettetDato", "Sykehusnavn", "AvdRESH", - "Op_gr", "Hovedoperasjon")], - skjemaoversikt[skjemaoversikt$Skjemanavn=='Reinnleggelse/oppføl', c("ForlopsID", "SkjemaStatus")], - by = 'ForlopsID', all.x = T, suffixes = c('', '_oppf')) + fraDato <- lubridate::`%m-%`(tilDato, + lubridate::years(input$ant_aar)) %>% + lubridate::floor_date(unit="years") + tmp <- merge( + skjemaoversikt[skjemaoversikt$Skjemanavn=='Registrering', + c("ForlopsID", "SkjemaStatus", "HovedDato", + "OpprettetDato", "Sykehusnavn", "AvdRESH", + "Op_gr", "Hovedoperasjon")], + skjemaoversikt[skjemaoversikt$Skjemanavn=='Reinnleggelse/oppføl', + c("ForlopsID", "SkjemaStatus")], + by = 'ForlopsID', all.x = T, suffixes = c('', '_oppf')) if (input$kun_oblig) { - # tmp <- tmp[tmp$ForlopsID %in% RegData$ForlopsID[RegData$Op_gr %in% 1:7], ] tmp <- tmp[tmp$Op_gr %in% 1:8, ] } tmp$SkjemaStatus[tmp$SkjemaStatus==-1] <- 0 tmp$SkjemaStatus_oppf[tmp$SkjemaStatus_oppf==-1] <- 0 - tmp$HovedDato[is.na(tmp$HovedDato)] <- as.Date(tmp$OpprettetDato[is.na(tmp$HovedDato)]) - if (!is.null(input$op_gruppe)) {tmp <- tmp[which(tmp$Op_gr %in% as.numeric(input$op_gruppe)), ]} - if (!is.null(input$ncsp_verdi)) {tmp <- tmp[which(substr(tmp$Hovedoperasjon, 1, 5) %in% input$ncsp_verdi), ]} - if (!is.null(input$valgtShus)) {tmp <- tmp[tmp$AvdRESH %in% as.numeric(input$valgtShus), ]} + tmp$HovedDato[is.na(tmp$HovedDato)] <- + as.Date(tmp$OpprettetDato[is.na(tmp$HovedDato)]) + if (!is.null(input$op_gruppe)) { + tmp <- tmp[which(tmp$Op_gr %in% as.numeric(input$op_gruppe)), ]} + if (!is.null(input$ncsp_verdi)) { + tmp <- tmp[which(substr(tmp$Hovedoperasjon, 1, 5) %in% + input$ncsp_verdi), ]} + if (!is.null(input$valgtShus) & userRole() == "SC") { + tmp <- tmp[tmp$AvdRESH %in% as.numeric(input$valgtShus), ]} aux <- tmp - aux$mnd <- factor(format(aux$HovedDato, format='%Y'), levels = format(seq(as.Date(fraDato),as.Date(input$datovalg_adm_tid_aar), by="year"), "%Y")) + aux$mnd <- factor( + format(aux$HovedDato, format='%Y'), + levels = format(seq(as.Date(fraDato), + as.Date(input$datovalg_adm_tid_aar), + by="year"), "%Y")) ant_skjema <- switch ( req(input$regstatus_tid), '1' = as.data.frame.matrix( addmargins( - table(aux[which(aux$SkjemaStatus==1 & (aux$SkjemaStatus_oppf==1 | - is.na(aux$SkjemaStatus_oppf))) , + table(aux[which(aux$SkjemaStatus==1 & + (aux$SkjemaStatus_oppf==1 | + is.na(aux$SkjemaStatus_oppf))) , c('Sykehusnavn', 'mnd')]))), '2' = as.data.frame.matrix( addmargins( - table(aux[which(aux$SkjemaStatus==1 & aux$SkjemaStatus_oppf==0) , + table(aux[which(aux$SkjemaStatus==1 & + aux$SkjemaStatus_oppf==0), c('Sykehusnavn', 'mnd')]))), '3' = as.data.frame.matrix( addmargins( - table(aux[which(aux$SkjemaStatus==1 & is.na(aux$SkjemaStatus_oppf)) , + table(aux[which(aux$SkjemaStatus==1 & + is.na(aux$SkjemaStatus_oppf)), c('Sykehusnavn', 'mnd')]))), '4' = as.data.frame.matrix( addmargins( - table(aux[which(aux$SkjemaStatus==0) , c('Sykehusnavn', 'mnd')]))) + table(aux[which(aux$SkjemaStatus==0) , + c('Sykehusnavn', 'mnd')]))) ) %>% dplyr::as_tibble(rownames = 'Sykehusnavn') } sketch <- htmltools::withTags(table( DT::tableHeader(ant_skjema[-dim(ant_skjema)[1], ]), - DT::tableFooter(c('Sum' , as.numeric(ant_skjema[dim(ant_skjema)[1], 2:dim(ant_skjema)[2]]))))) + DT::tableFooter( + c('Sum' , as.numeric(ant_skjema[dim(ant_skjema)[1], + 2:dim(ant_skjema)[2]]))))) list(ant_skjema=ant_skjema, sketch=sketch) } output$Tabell_adm2 = DT::renderDT( - DT::datatable(andre_adm_tab()$ant_skjema[-dim(andre_adm_tab()$ant_skjema)[1], ], - container = andre_adm_tab()$sketch, - rownames = F, - options = list(pageLength = 40) + DT::datatable( + andre_adm_tab()$ant_skjema[-dim(andre_adm_tab()$ant_skjema)[1], ], + container = andre_adm_tab()$sketch, + rownames = F, + options = list(pageLength = 40) ) ) @@ -386,7 +426,8 @@ admtab_server <- function(id, RegData, userRole, mld_adm1 <- paste0( "NORGAST: Admin. tabell: Antall skjema pr ", c('måned', 'år')[as.numeric(input$adm_tidsenhet)], ". ", - c('Ferdige forløp', 'Oppfølging i kladd', 'Ferdig basisreg. oppfølging mangler', + c('Ferdige forløp', 'Oppfølging i kladd', + 'Ferdig basisreg. oppfølging mangler', 'Basisreg. i kladd')[as.numeric(input$regstatus_tid)]) } rapbase::repLogger( @@ -398,18 +439,21 @@ admtab_server <- function(id, RegData, userRole, "lastNed_adm1", rapbase::repLogger( session = hvd_session, - msg = paste0("NORGAST: nedlasting tabell: Antall skjema, dato ", - input$datovalg_adm[1], ' til ', input$datovalg_adm[2]) + msg = paste0( + "NORGAST: nedlasting tabell: Antall skjema, dato ", + input$datovalg_adm[1], ' til ', input$datovalg_adm[2]) ) ) shinyjs::onclick( "lastNed_adm2", rapbase::repLogger( session = hvd_session, - msg = paste0("NORGAST: nedlasting tabell: Antall skjema pr ", - c('måned', 'år')[as.numeric(input$adm_tidsenhet)], ". ", - c('Ferdige forløp', 'Oppfølging i kladd', 'Ferdig basisreg. oppfølging mangler', - 'Basisreg. i kladd')[as.numeric(input$regstatus_tid)]) + msg = paste0( + "NORGAST: nedlasting tabell: Antall skjema pr ", + c('måned', 'år')[as.numeric(input$adm_tidsenhet)], ". ", + c('Ferdige forløp', 'Oppfølging i kladd', + 'Ferdig basisreg. oppfølging mangler', + 'Basisreg. i kladd')[as.numeric(input$regstatus_tid)]) ) ) } diff --git a/R/modul_fordelingsfig.R b/R/modul_fordelingsfig.R index de91f09..2634a4d 100644 --- a/R/modul_fordelingsfig.R +++ b/R/modul_fordelingsfig.R @@ -13,33 +13,38 @@ fordelingsfig_ui <- function(id){ width = 3, id = ns("id_fordeling_panel"), # checkboxInput(inputId = ns("referansepasient"), label = "Velg referansepasient"), - checkboxInput(inputId = ns("kun_ferdigstilte"), - label = "Inkludér kun komplette forløp (også oppfølging ferdigstilt)", - value = TRUE), + checkboxInput( + inputId = ns("kun_ferdigstilte"), + label = "Inkludér kun komplette forløp (også oppfølging ferdigstilt)", + value = TRUE), uiOutput(outputId = ns('valgtVar_ui')), - dateRangeInput(inputId=ns("datovalg"), label = "Dato fra og til", - min = '2014-01-01', - max = Sys.Date(), - start = lubridate::floor_date(lubridate::today() - - lubridate::years(1), unit = "year"), - end = Sys.Date(), language = "nb", separator = " til "), - selectInput(inputId = ns("enhetsUtvalg"), label = "Kjør rapport for", - choices = c('Hele landet'=0, 'Egen avd. mot landet forøvrig'=1, - 'Egen avd.'=2)), + dateRangeInput( + inputId=ns("datovalg"), label = "Dato fra og til", + min = '2014-01-01', + max = Sys.Date(), + start = lubridate::floor_date(lubridate::today() - + lubridate::years(1), unit = "year"), + end = Sys.Date(), language = "nb", separator = " til "), + selectInput( + inputId = ns("enhetsUtvalg"), label = "Kjør rapport for", + choices = c('Hele landet'=0, 'Egen avd. mot landet forøvrig'=1, + 'Egen avd.'=2)), uiOutput(outputId = ns('valgtShus_ui')), uiOutput(outputId = ns('tilgang_utvidet_ui')), sliderInput(inputId=ns("alder"), label = "Alder", min = 0, max = 120, value = c(0, 120)), selectInput(inputId = ns("erMann"), label = "Kjønn", choices = c('Begge'=99, 'Kvinne'=0, 'Mann'=1)), - selectInput(inputId = ns("elektiv"), label = "Tidspunkt for operasjonsstart", + selectInput(inputId = ns("elektiv"), + label = "Tidspunkt for operasjonsstart", choices = c('Ikke valgt'=99, 'Innenfor normalarbeidstid'=1, 'Utenfor normalarbeidstid'=0)), selectInput(inputId = ns("hastegrad"), label = "Hastegrad", choices = c('Ikke valgt'=99, 'Elektiv'=1, 'Akutt'=2)), - selectInput(inputId = ns("hastegrad_hybrid"), label = "Hastegrad, hybrid + selectInput( + inputId = ns("hastegrad_hybrid"), label = "Hastegrad, hybrid (bruker hastegrad når den finnes, ellers tidspkt for op.start)", - choices = c('Ikke valgt'=99, 'Elektiv'=1, 'Akutt'=0)), + choices = c('Ikke valgt'=99, 'Elektiv'=1, 'Akutt'=0)), # shinyjs::hidden( # div( # id = ns("avansert"), @@ -52,7 +57,8 @@ fordelingsfig_ui <- function(id){ selectInput(inputId = ns("modGlasgow"), label = "Modified Glasgow score", choices = 0:2, multiple = TRUE), uiOutput(outputId = ns('whoEcog_ui')), - selectInput(inputId = ns("forbehandling"), label = "Onkologisk forbehandling", + selectInput(inputId = ns("forbehandling"), + label = "Onkologisk forbehandling", multiple = TRUE, choices = c('Cytostatika'=1, 'Stråleterapi'=2, 'Komb. kjemo/radioterapi'=3, 'Ingen'=4)), @@ -74,14 +80,17 @@ fordelingsfig_ui <- function(id){ ), mainPanel( tabsetPanel(id = ns("tab"), - tabPanel("Figur", value = "fig", - plotOutput(ns("Figur1"), height="auto"), downloadButton(ns("lastNedBilde"), "Last ned figur")), - tabPanel("Tabell", value = "tab", - uiOutput(ns("utvalg")), - # textOutput(ns("utvalg")), - br(), - tableOutput(ns("Tabell1")), - downloadButton(ns("lastNed"), "Last ned tabell")) + tabPanel( + "Figur", value = "fig", + plotOutput(ns("Figur1"), height="auto"), + downloadButton(ns("lastNedBilde"), "Last ned figur")), + tabPanel( + "Tabell", value = "tab", + uiOutput(ns("utvalg")), + # textOutput(ns("utvalg")), + br(), + tableOutput(ns("Tabell1")), + downloadButton(ns("lastNed"), "Last ned tabell")) ) ) ) @@ -97,7 +106,8 @@ fordelingsfig_ui <- function(id){ #' @return Modul fordelingsfigur #' #' @export -fordelingsfig_server <- function(id, reshID, RegData, userRole, hvd_session, BrValg){ +fordelingsfig_server <- function(id, reshID, RegData, userRole, + hvd_session, BrValg){ moduleServer( id, function(input, output, session) { @@ -153,7 +163,8 @@ fordelingsfig_server <- function(id, reshID, RegData, userRole, hvd_session, BrV output$op_gruppe_ui <- renderUI({ ns <- session$ns - selectInput(inputId = ns("op_gruppe"), label = "Velg reseksjonsgruppe(r)", + selectInput(inputId = ns("op_gruppe"), + label = "Velg reseksjonsgruppe(r)", choices = BrValg$reseksjonsgrupper, multiple = TRUE) }) @@ -177,14 +188,16 @@ fordelingsfig_server <- function(id, reshID, RegData, userRole, hvd_session, BrV output$icd <- renderUI({ ns <- session$ns - Utvalg1 <- NorgastUtvalg(RegData = RegData, - op_gruppe = if (!is.null(input$op_gruppe)) {input$op_gruppe} else {''}, - ncsp = if (!is.null(input$ncsp_verdi)) {input$ncsp_verdi} else {''}, - malign = as.numeric(input$malign)) + Utvalg1 <- NorgastUtvalg( + RegData = RegData, + op_gruppe = if (!is.null(input$op_gruppe)) {input$op_gruppe} else {''}, + ncsp = if (!is.null(input$ncsp_verdi)) {input$ncsp_verdi} else {''}, + malign = as.numeric(input$malign)) Utvalg1 <- Utvalg1$RegData diagnoser <- names(sort(table(Utvalg1$Hoveddiagnose2), decreasing = T)) if (!is.null(diagnoser)) { - selectInput(inputId = ns("icd_verdi"), label = "Spesifiser ICD-10 koder (velg en eller flere)", + selectInput(inputId = ns("icd_verdi"), + label = "Spesifiser ICD-10 koder (velg en eller flere)", choices = diagnoser, multiple = TRUE) } }) @@ -192,35 +205,46 @@ fordelingsfig_server <- function(id, reshID, RegData, userRole, hvd_session, BrV tabellReager <- reactive({ TabellData <- norgast::NorgastBeregnAndeler( RegData = RegData, - valgtVar = if (!is.null(input$valgtVar)) {input$valgtVar} else {'Alder'}, + valgtVar = if (!is.null(input$valgtVar)) { + input$valgtVar} else {'Alder'}, minald=as.numeric(input$alder[1]), - maxald=as.numeric(input$alder[2]), datoFra = input$datovalg[1], datoTil = input$datovalg[2], - valgtShus = if (!is.null(input$valgtShus)) {input$valgtShus} else {''}, + maxald=as.numeric(input$alder[2]), + datoFra = input$datovalg[1], datoTil = input$datovalg[2], + valgtShus = if (!is.null(input$valgtShus) & userRole() == "SC") { + input$valgtShus} else {''}, op_gruppe = if (!is.null(input$op_gruppe)) {input$op_gruppe} else {''}, ncsp = if (!is.null(input$ncsp_verdi)) {input$ncsp_verdi} else {''}, BMI = if (!is.null(input$BMI)) {input$BMI} else {''}, - tilgang_utvidet = if (!is.null(input$tilgang_utvidet)) {input$tilgang_utvidet} else {''}, + tilgang_utvidet = if (!is.null(input$tilgang_utvidet)) { + input$tilgang_utvidet} else {''}, minPRS = as.numeric(input$PRS[1]), maxPRS = as.numeric(input$PRS[2]), ASA = if (!is.null(input$ASA)) {input$ASA} else {''}, modGlasgow = fiksNULL(input$modGlasgow), whoEcog = if (!is.null(input$whoEcog)) {input$whoEcog} else {''}, - forbehandling = if (!is.null(input$forbehandling)) {input$forbehandling} else {''}, + forbehandling = if (!is.null(input$forbehandling)) { + input$forbehandling} else {''}, malign = as.numeric(input$malign), - reshID = reshID(), enhetsUtvalg = input$enhetsUtvalg, erMann = as.numeric(input$erMann), - elektiv = as.numeric(input$elektiv), hastegrad = as.numeric(input$hastegrad), + reshID = reshID(), enhetsUtvalg = input$enhetsUtvalg, + erMann = as.numeric(input$erMann), + elektiv = as.numeric(input$elektiv), + hastegrad = as.numeric(input$hastegrad), hastegrad_hybrid = as.numeric(input$hastegrad_hybrid), kun_ferdigstilte = input$kun_ferdigstilte, ny_stomi = as.numeric(input$ny_stomi), - accordion = if (!is.null(input$accordion)) {input$accordion} else {''}, + accordion = if (!is.null(input$accordion)) { + input$accordion} else {''}, icd = if (!is.null(input$icd_verdi)) {input$icd_verdi} else {''}) }) output$Figur1 <- renderPlot({ norgast::NorgastPlotAndeler( - PlotParams=tabellReager()$PlotParams, utvalgTxt=tabellReager()$utvalgTxt, - Andeler=tabellReager()$Andeler, Antall=tabellReager()$Antall, - fargepalett=tabellReager()$fargepalett, enhetsUtvalg=tabellReager()$enhetsUtvalg, + PlotParams=tabellReager()$PlotParams, + utvalgTxt=tabellReager()$utvalgTxt, + Andeler=tabellReager()$Andeler, + Antall=tabellReager()$Antall, + fargepalett=tabellReager()$fargepalett, + enhetsUtvalg=tabellReager()$enhetsUtvalg, shtxt=tabellReager()$shtxt ) }, width = 700, height = 700) @@ -243,16 +267,21 @@ fordelingsfig_server <- function(id, reshID, RegData, userRole, hvd_session, BrV dplyr::mutate(AndelHoved = 100*AntHoved/NHoved) %>% dplyr::mutate(AndelRest= 100*AntRest/Nrest) Tabell1 <- Tabell1[, c(1,2,4,6,3,5,7)] - names(Tabell1) <- c('Kategori', 'Antall i kategori', 'Antall totalt', 'Andel (%)', 'Antall i kategori', 'Antall totalt', 'Andel (%)') - Tabell1 %>% knitr::kable("html", digits = c(0,0,0,1,0,0,1), row.names = F) %>% + names(Tabell1) <- c( + 'Kategori', 'Antall i kategori', 'Antall totalt', 'Andel (%)', + 'Antall i kategori', 'Antall totalt', 'Andel (%)') + Tabell1 %>% knitr::kable("html", digits = c(0,0,0,1,0,0,1), + row.names = F) %>% kableExtra::kable_styling("hover", full_width = F) %>% - kableExtra::add_header_above(c(" ", "Din avdeling" = 3, "Landet forøvrig" = 3)) + kableExtra::add_header_above(c(" ", "Din avdeling" = 3, + "Landet forøvrig" = 3)) } else { Tabell1 <- TabellData$Antall %>% dplyr::mutate(Kategori = rownames(.)) %>% dplyr::select(Kategori, everything()) %>% dplyr::mutate(AndelHoved = 100*AntHoved/NHoved) - names(Tabell1) <- c('Kategori', 'Antall i kategori', 'Antall totalt', 'Andel (%)') + names(Tabell1) <- c('Kategori', 'Antall i kategori', + 'Antall totalt', 'Andel (%)') Tabell1 %>% knitr::kable("html", digits = c(0,0,0,1), row.names = F) %>% kableExtra::kable_styling("hover", full_width = F) @@ -292,9 +321,12 @@ fordelingsfig_server <- function(id, reshID, RegData, userRole, hvd_session, BrV content = function(file){ norgast::NorgastPlotAndeler( - PlotParams=tabellReager()$PlotParams, utvalgTxt=tabellReager()$utvalgTxt, - Andeler=tabellReager()$Andeler, Antall=tabellReager()$Antall, - fargepalett=tabellReager()$fargepalett, enhetsUtvalg=tabellReager()$enhetsUtvalg, + PlotParams=tabellReager()$PlotParams, + utvalgTxt=tabellReager()$utvalgTxt, + Andeler=tabellReager()$Andeler, + Antall=tabellReager()$Antall, + fargepalett=tabellReager()$fargepalett, + enhetsUtvalg=tabellReager()$enhetsUtvalg, shtxt=tabellReager()$shtxt, outfile = file) } )