DiagnostikApps/GAD7/app.R
2026-09-22 18:35:43 +02:00

715 lines
25 KiB
R
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

# Präambel ####
library(shiny)
library(dplyr)
library(ggplot2)
library(haven)
library(officer)
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_gad7.R" # liefert: daten_gad7
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R" # liefert: pseudo
AKZENT_FARBE = "#8B2635"
GAD7_DISCLAIMER = paste0(
"Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
"keine klinische Diagnose. Die Interpretation obliegt der behandelnden Person."
)
# Feste Itemtexte (aus dem formr-xlsx, ** entfernt), NICHT aus dem Export ableiten,
# da das mc-Exportformat noch nicht live verifiziert ist (siehe Helper-Abschnitt).
GAD7_ITEMTEXTE = c(
gad7_01 = "1. Nervositaet, Aengstlichkeit oder Anspannung",
gad7_02 = "2. Nicht in der Lage sein, Sorgen zu stoppen oder zu kontrollieren",
gad7_03 = "3. Uebermaessige Sorgen bezueglich verschiedener Angelegenheiten",
gad7_04 = "4. Schwierigkeiten zu entspannen",
gad7_05 = "5. Rastlosigkeit, so dass Stillsitzen schwer faellt",
gad7_06 = "6. Schnelle Veraergerung oder Gereiztheit",
gad7_07 = "7. Gefuehl der Angst, so als wuerde etwas Schlimmes passieren"
)
GAD7_ANTWORT_MAPPING = c(
"Überhaupt nicht" = 0,
"An einzelnen Tagen" = 1,
"An mehr als der Hälfte der Tage" = 2,
"Beinahe jeden Tag" = 3
)
# Verlauf gruen -> dunkelrot entspricht den 4 Antwortstufen 0-3.
GAD7_BADGE_FARBEN = c(
"0" = "#4CAF50",
"1" = "#FFC107",
"2" = "#FB8C00",
"3" = "#B71C1C"
)
GAD7_BADGE_TEXT_FARBEN = c(
"0" = "white",
"1" = "#333333",
"2" = "white",
"3" = "white"
)
GAD7_SCHWEREGRAD_FARBEN = list(
"minimal" = list(bg = "#E8F5E9", text = "#2E7D32"),
"mild" = list(bg = "#FFF8E1", text = "#F57F17"),
"moderat" = list(bg = "#FFF3E0", text = "#E65100"),
"schwer" = list(bg = "#FFEBEE", text = "#B71C1C")
)
# Infrastruktur ####
APP_VERZEICHNIS = normalizePath(getwd())
absPath = function(pfad) {
if (grepl("^([A-Za-z]:[/\\\\]|/)", pfad)) return(pfad)
file.path(APP_VERZEICHNIS, pfad)
}
PFAD_DOWNLOAD_SKRIPT = normalizePath(absPath(PFAD_DOWNLOAD_SKRIPT), mustWork = FALSE)
PFAD_PSEUDONYM_SKRIPT = normalizePath(absPath(PFAD_PSEUDONYM_SKRIPT), mustWork = FALSE)
# Helper ####
# Offener Verifikationspunkt: die formr-Exportkodierung der mc-Felder (Text
# der gewaehlten Antwort vs. 1-basierter Choice-Index) ist fuer diese Instanz
# noch nicht live getestet (siehe auswertung_normen_gad7.md, Abschnitt G).
# Diese Funktion deckt beide moeglichen Faelle sowie eine bereits 0-3-kodierte
# Variante ab. Kommen unbekannte_rohwerte zurueck, beim ersten echten
# Testlauf genau diese Rohwerte notieren und melden.
gad7_recode_item = function(werte) {
if (inherits(werte, "haven_labelled")) {
werte = as.character(haven::as_factor(werte))
}
werte_char = trimws(as.character(werte))
ergebnis = rep(NA_real_, length(werte_char))
ist_leer = is.na(werte_char) | werte_char == ""
passt_text = werte_char %in% names(GAD7_ANTWORT_MAPPING)
ergebnis[passt_text] = GAD7_ANTWORT_MAPPING[werte_char[passt_text]]
ist_numerisch = !ist_leer & !passt_text & grepl("^[0-9]+$", werte_char)
moeglich_index = ist_numerisch & as.numeric(werte_char) >= 1 & as.numeric(werte_char) <= 4
ergebnis[moeglich_index] = as.numeric(werte_char[moeglich_index]) - 1
moeglich_direkt = ist_numerisch & !moeglich_index &
as.numeric(werte_char) >= 0 & as.numeric(werte_char) <= 3
ergebnis[moeglich_direkt] = as.numeric(werte_char[moeglich_direkt])
nicht_erkannt = !ist_leer & is.na(ergebnis)
list(werte = ergebnis, unbekannte_rohwerte = unique(werte_char[nicht_erkannt]))
}
gad7_schweregrad = function(score) {
if (score >= 15) return(list(key = "schwer", label = "Schwer"))
if (score >= 10) return(list(key = "moderat", label = "Moderat"))
if (score >= 5) return(list(key = "mild", label = "Mild"))
list(key = "minimal", label = "Minimal")
}
gad7_antwort_text = function(stufe) {
if (is.na(stufe)) return(NA_character_)
treffer = names(GAD7_ANTWORT_MAPPING)[GAD7_ANTWORT_MAPPING == as.integer(stufe)]
if (length(treffer) == 0) return(NA_character_)
treffer[1]
}
make_gauge_gad7 = function(score) {
ggplot() +
geom_rect(aes(xmin = 0, xmax = 5, ymin = 0, ymax = 1), fill = "#E8F5E9", color = NA) +
geom_rect(aes(xmin = 5, xmax = 10, ymin = 0, ymax = 1), fill = "#FFF8E1", color = NA) +
geom_rect(aes(xmin = 10, xmax = 15, ymin = 0, ymax = 1), fill = "#FFF3E0", color = NA) +
geom_rect(aes(xmin = 15, xmax = 21, ymin = 0, ymax = 1), fill = "#FFEBEE", color = NA) +
geom_rect(aes(xmin = 0, xmax = 21, ymin = 0, ymax = 1), fill = NA, color = "#9E9E9E", linewidth = 0.6) +
geom_vline(xintercept = 10, color = "#E65100", linetype = "dashed", linewidth = 1) +
geom_segment(aes(x = score, xend = score, y = -0.25, yend = 1.25),
color = AKZENT_FARBE, linewidth = 2.5) +
geom_label(aes(x = score, y = 1.6, label = paste0("Score: ", score)),
fill = AKZENT_FARBE, color = "white", fontface = "bold",
linewidth = 0, size = 4) +
annotate("text", x = 10, y = -0.55, label = "Cutoff: 10",
color = "#E65100", size = 3.2, hjust = 0.5) +
annotate("text", x = 2.5, y = 0.5, label = "minimal", color = "#2E7D32", size = 3, fontface = "italic") +
annotate("text", x = 18.3, y = 0.5, label = "schwer", color = "#B71C1C", size = 3, fontface = "italic") +
scale_x_continuous(limits = c(-1, 22), breaks = c(0, 5, 10, 15, 21)) +
scale_y_continuous(limits = c(-0.8, 2.0)) +
theme_minimal(base_size = 12) +
theme(
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor = element_blank(),
axis.title.y = element_blank(),
plot.margin = margin(t = 5, r = 10, b = 5, l = 10)
) +
labs(x = "GAD-7 Summenscore (0-21)", y = NULL)
}
# UI ####
app_css = "
body { font-family: 'Segoe UI', Arial, sans-serif; background: #f5f5f5; }
.app-header {
background: #8B2635; color: white; padding: 18px 24px 14px;
margin-bottom: 20px; border-radius: 0 0 6px 6px;
}
.app-header h2 { margin: 0; font-size: 1.5rem; font-weight: 600; }
.app-header p { margin: 4px 0 0; opacity: 0.85; font-size: 0.9rem; }
.input-panel {
background: white; border-radius: 6px; padding: 16px 20px;
margin-bottom: 16px; box-shadow: 0 1px 3px rgba(0,0,0,.12);
display: flex; align-items: flex-end; gap: 12px; flex-wrap: wrap;
}
.input-panel .form-group { margin-bottom: 0; }
.input-panel label { font-weight: 600; color: #333; }
.btn-laden {
background: #8B2635 !important; color: white !important;
border: none !important; border-radius: 4px !important;
padding: 8px 20px !important; font-weight: 600 !important; cursor: pointer;
}
.btn-laden:hover { background: #6d1e29 !important; }
#download_word {
background: #8B2635; color: white; border: none;
font-weight: 600; padding: 8px 20px; border-radius: 4px;
}
#download_word:hover { background: #6d1e29; color: white; }
.alert-fehler {
background: #FFEBEE; border-left: 5px solid #C62828;
padding: 12px 16px; border-radius: 4px; color: #B71C1C;
margin-bottom: 12px; font-weight: 500;
}
.alert-warnung {
background: #FFF3E0; border-left: 5px solid #E65100;
padding: 10px 16px; border-radius: 4px; color: #BF360C;
margin-bottom: 12px; font-size: 0.93em; font-weight: 500;
}
.abschnitt-karte {
background: white; border-radius: 6px; padding: 20px 24px;
margin-bottom: 16px; box-shadow: 0 1px 3px rgba(0,0,0,.12);
}
.abschnitt-titel {
color: #8B2635; font-size: 1.15rem; font-weight: 700;
border-bottom: 2px solid #8B2635; padding-bottom: 8px; margin-bottom: 14px;
}
.meta-block { margin-bottom: 10px; color: #555; font-size: 0.95em; }
.meta-block strong { color: #222; }
.diagnose-box {
border-radius: 6px; padding: 14px 18px; margin: 12px 0;
border-left: 5px solid;
}
.diagnose-titel { font-weight: 700; font-size: 1.05rem; margin-bottom: 6px; }
.diagnose-hinweis { font-size: 0.93em; line-height: 1.55; }
.diagnose-disclaimer {
font-size: 0.82em; color: #777; font-style: italic;
margin-top: 10px; border-top: 1px solid rgba(0,0,0,.1); padding-top: 8px;
}
.item-zeile {
display: flex; align-items: flex-start; gap: 10px;
padding: 7px 0; border-bottom: 1px solid #F0F0F0;
}
.item-nr { font-weight: 600; color: #8B2635; min-width: 26px; flex-shrink: 0; }
.item-text { flex: 1; color: #333; font-size: 0.92em; }
.stufe-badge {
border-radius: 4px; padding: 2px 9px; font-weight: 700;
font-size: 0.82em; white-space: nowrap; display: inline-block; flex-shrink: 0;
}
.stufe-badge-0 { background: #4CAF50; color: white; }
.stufe-badge-1 { background: #FFC107; color: #333333; }
.stufe-badge-2 { background: #FB8C00; color: white; }
.stufe-badge-3 { background: #B71C1C; color: white; }
.score-zahl { font-size: 2.2rem; font-weight: 800; color: #8B2635; }
.cutoff-info { font-size: 0.88em; color: #555; margin-top: 4px; }
"
app_css = gsub("#8B2635", AKZENT_FARBE, app_css, fixed = TRUE)
ui = fluidPage(
tags$head(
tags$meta(charset = "UTF-8"),
tags$style(HTML(app_css))
),
div(class = "app-header",
tags$h2("GAD-7 Generalisierte Angststoerung"),
tags$p("Spitzer, Kroenke, Williams & Loewe 2006 | Selbstbeurteilung, 7 Items, Summenscore")
),
div(class = "container-fluid",
div(class = "input-panel",
div(style = "min-width: 360px; white-space: nowrap;",
textInput("pseudonym",
label = tagList(
"Pseudonym",
tags$span(style = "font-weight: normal; font-style: italic; font-size: 0.78em; color: #888; margin-left: 4px; white-space: nowrap;",
"optional, hat Vorrang vor Chiffre")
),
placeholder = "optional", width = "340px")
),
div(style = "min-width: 200px;",
textInput("chiffre", label = "Patientenchiffre",
placeholder = "z.B. P000123", width = "100%")
),
actionButton("btn_suchen", "Auswerten", class = "btn btn-primary btn-laden"),
div(style = "margin-left: auto;",
downloadButton("download_word", "Word-Export (.docx)")
)
),
uiOutput("fehler_ui"),
uiOutput("warnung_ui"),
uiOutput("ergebnis_ui")
)
)
# Word-Export ####
erstelle_gad7_docx = function(erg) {
doc = read_docx()
fp_titel = fp_text(color = AKZENT_FARBE, bold = TRUE, font.size = 18)
fp_abschnitt = fp_text(color = AKZENT_FARBE, bold = TRUE, font.size = 13)
fp_label = fp_text(bold = TRUE, font.size = 11)
fp_normal = fp_text(font.size = 11)
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
schwere = erg$schwere
kat_farben = GAD7_SCHWEREGRAD_FARBEN[[schwere$key]]
fp_kat_titel = fp_text(bold = TRUE, font.size = 12, color = kat_farben$text, shading.color = kat_farben$bg)
fp_kat_text = fp_text(font.size = 11, color = kat_farben$text, shading.color = kat_farben$bg)
fp_cutoff = if (isTRUE(erg$cutoff_erreicht))
fp_text(bold = TRUE, font.size = 11, color = "#B71C1C")
else
fp_text(bold = TRUE, font.size = 11, color = "#2E7D32")
doc = body_add_fpar(doc, fpar(ftext("GAD-7 - Einzelauswertung", fp_titel)))
doc = body_add_fpar(doc, fpar(
ftext("Chiffre: ", fp_label),
ftext(erg$chiffre, fp_normal),
ftext(" Datum: ", fp_label),
ftext(erg$datum_str, fp_normal)
))
if (!is.null(erg$info_mehrere)) {
doc = body_add_fpar(doc, fpar(
ftext(erg$info_mehrere, fp_text(font.size = 10, italic = TRUE, color = "#555555"))
))
}
doc = body_add_par(doc, "", style = "Normal")
doc = body_add_fpar(doc, fpar(ftext("Auswertung", fp_abschnitt)))
doc = body_add_fpar(doc, fpar(
ftext("Summenscore: ", fp_label),
ftext(paste0(erg$summenscore, " / 21"), fp_kat_text)
))
doc = body_add_fpar(doc, fpar(
ftext("Schweregrad: ", fp_label),
ftext(schwere$label, fp_kat_titel)
))
doc = body_add_fpar(doc, fpar(
ftext("Diagnostischer Cutoff (Score >= 10, Sensitivitaet 89%, Spezifitaet 82%): ", fp_label),
ftext(if (isTRUE(erg$cutoff_erreicht)) "erreicht - wahrscheinliche GAD" else "nicht erreicht", fp_cutoff)
))
doc = body_add_par(doc, "", style = "Normal")
doc = body_add_fpar(doc, fpar(ftext("GAD-7 Einzelitems", fp_abschnitt)))
item_vars = names(GAD7_ITEMTEXTE)
for (v in item_vars) {
wert = erg$item_werte[[v]]
sk = if (!is.na(wert) && wert >= 0 && wert <= 3) as.character(as.integer(wert)) else NA_character_
item_txt = GAD7_ITEMTEXTE[[v]]
if (!is.na(sk)) {
anker_txt = gad7_antwort_text(as.integer(sk))
fp_badge = fp_text(
color = GAD7_BADGE_TEXT_FARBEN[[sk]],
bold = TRUE,
shading.color = GAD7_BADGE_FARBEN[[sk]],
font.size = 10
)
} else {
anker_txt = "fehlend"
fp_badge = fp_text(color = "white", bold = TRUE, shading.color = "#BDBDBD", font.size = 10)
}
doc = body_add_fpar(doc, fpar(
ftext(paste0(item_txt, " "), fp_normal),
ftext(paste0(" ", anker_txt, " "), fp_badge)
))
}
doc = body_add_par(doc, "", style = "Normal")
doc = body_add_fpar(doc, fpar(ftext(GAD7_DISCLAIMER, fp_disclaimer)))
doc
}
# Server ####
server = function(input, output, session) {
observe({
query = parseQueryString(session$clientData$url_search)
if (!is.null(query$pseudonym) && nchar(trimws(query$pseudonym)) > 0) {
updateTextInput(session, "pseudonym", value = trimws(query$pseudonym))
}
})
observe({
query = parseQueryString(session$clientData$url_search)
if (!is.null(query$chiffre) && nchar(trimws(query$chiffre)) > 0) {
updateTextInput(session, "chiffre", value = toupper(trimws(query$chiffre)))
}
})
# Skripte werden NICHT beim App-Start gesourct, nur beim Klick auf "Auswerten".
ergebnis_r = eventReactive(input$btn_suchen, {
chiffre = toupper(trimws(input$chiffre))
pseudonym_eingabe = trimws(input$pseudonym)
if (nchar(pseudonym_eingabe) == 0 && nchar(chiffre) == 0)
return(list(error = "Bitte Chiffre oder Pseudonym eingeben."))
if (nchar(pseudonym_eingabe) == 0 && !grepl("^[A-Z][0-9]{6}$", chiffre))
return(list(error = paste0(
"Ungueltige Chiffre. Erwartet: ein Grossbuchstabe + 6 Ziffern (z.B. P000123).")))
if (!file.exists(PFAD_DOWNLOAD_SKRIPT))
return(list(error = paste0(
"Download-Skript nicht gefunden:\n", PFAD_DOWNLOAD_SKRIPT)))
if (!file.exists(PFAD_PSEUDONYM_SKRIPT))
return(list(error = paste0(
"Pseudonym-Skript nicht gefunden:\n", PFAD_PSEUDONYM_SKRIPT)))
res_dl = tryCatch(
{ source(PFAD_DOWNLOAD_SKRIPT, local = FALSE); list(ok = TRUE) },
error = function(e) list(ok = FALSE, msg = e$message)
)
if (!res_dl$ok)
return(list(error = paste0("Fehler im Download-Skript: ", res_dl$msg)))
db_ordner = local({
ordner = dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE))
gefunden = NULL
for (i in 1:5) {
if (file.exists(file.path(ordner, "pseudonyme.db"))) {
gefunden = ordner
break
}
elternteil = dirname(ordner)
if (elternteil == ordner) break
ordner = elternteil
}
gefunden
})
alter_wd = getwd()
wd_ziel = if (!is.null(db_ordner)) db_ordner else
dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE))
setwd(wd_ziel)
on.exit(setwd(alter_wd), add = TRUE)
res_ps = tryCatch(
{ source(PFAD_PSEUDONYM_SKRIPT, local = FALSE); list(ok = TRUE) },
error = function(e) list(ok = FALSE, msg = e$message)
)
if (!res_ps$ok)
return(list(error = paste0("Fehler im Pseudonym-Skript: ", res_ps$msg)))
if (!exists("daten_gad7", envir = .GlobalEnv))
return(list(error = paste0(
"Objekt 'daten_gad7' nach dem Sourcen nicht gefunden. ",
"Bitte Download-Skript pruefen.")))
if (!exists("pseudo", envir = .GlobalEnv))
return(list(error = paste0(
"Objekt 'pseudo' nach dem Sourcen nicht gefunden. ",
"Bitte Pseudonym-Skript pruefen.")))
daten = get("daten_gad7", envir = .GlobalEnv)
pseudo_df = get("pseudo", envir = .GlobalEnv)
session_spalte = if ("session" %in% names(daten)) "session" else NULL
if (is.null(session_spalte))
return(list(error = "Erwartete Session-/Pseudonym-Spalte in 'daten_gad7' nicht gefunden."))
# Chiffre-Rueckauflösung, falls ein Pseudonym eingegeben wurde (fuer
# Kopfzeile/Dateiname im Word-Export).
if (nchar(pseudonym_eingabe) > 0) {
pw_treffer = pseudo_df[pseudo_df$pseudonym == pseudonym_eingabe, ]
if (nrow(pw_treffer) > 0) chiffre = toupper(trimws(pw_treffer$chiffre[1]))
}
# Lookup: bei reiner Chiffre-Eingabe alle passenden Pseudonyme ziehen;
# ein eingegebenes Pseudonym ist immer ein exakter Override.
if (nchar(pseudonym_eingabe) == 0) {
treffer_ps = pseudo_df[pseudo_df$chiffre == chiffre, ]
if (nrow(treffer_ps) == 0)
return(list(error = paste0(
"Chiffre '", chiffre, "' wurde in der Pseudonym-Datenbank nicht gefunden.")))
alle_session_ids = unique(treffer_ps$pseudonym)
} else {
alle_session_ids = pseudonym_eingabe
}
treffer_dat = daten[daten[[session_spalte]] %in% alle_session_ids, ]
if (nrow(treffer_dat) == 0)
return(list(error = paste0(
"Kein GAD-7-Datensatz gefunden fuer ",
if (nchar(pseudonym_eingabe) > 0) paste0("Pseudonym '", pseudonym_eingabe, "'")
else paste0("Chiffre '", chiffre, "'"),
".")))
info_mehrere = NULL
if (nrow(treffer_dat) > 1) {
n = nrow(treffer_dat)
treffer_dat = treffer_dat[order(treffer_dat$created, decreasing = TRUE), ]
datum_neu = tryCatch(
format(as.POSIXct(treffer_dat$created[1]), "%d.%m.%Y %H:%M"),
error = function(e) "unbekanntes Datum"
)
info_mehrere = paste0(
"Mehrere Ausfuellungen gefunden (", n, " Eintraege). ",
"Angezeigt wird die neueste vom ", datum_neu, "."
)
treffer_dat = treffer_dat[1, , drop = FALSE]
}
zeile = treffer_dat[1, , drop = FALSE]
datum_str = tryCatch(
format(as.POSIXct(zeile[["created"]][1]), "%d.%m.%Y"),
error = function(e) format(Sys.Date(), "%d.%m.%Y")
)
item_vars = names(GAD7_ITEMTEXTE)
fehlende_spalten = item_vars[!item_vars %in% names(daten)]
if (length(fehlende_spalten) > 0)
return(list(error = paste0(
"Erwartete Item-Spalten fehlen in 'daten_gad7': ",
paste(fehlende_spalten, collapse = ", "))))
roh_werte = sapply(item_vars, function(v) zeile[[v]][1])
recode_erg = gad7_recode_item(roh_werte)
if (length(recode_erg$unbekannte_rohwerte) > 0)
return(list(error = paste0(
"Unbekannte Rohwerte in den GAD-7-Items gefunden: ",
paste(recode_erg$unbekannte_rohwerte, collapse = " | "),
". Die Exportkodierung entspricht keinem der bekannten Formate ",
"(Antworttext, 1-basierter Index 1-4, direkte 0-3-Kodierung). ",
"Bitte Rohwerte pruefen und melden - dies ist der noch offene ",
"Verifikationspunkt der formr-mc-Exportkodierung.")))
item_werte = recode_erg$werte
names(item_werte) = item_vars
basis = list(
error = NULL,
chiffre = chiffre,
datum_str = datum_str,
info_mehrere = info_mehrere,
item_werte = item_werte
)
fehlende_items = item_vars[is.na(item_werte)]
if (length(fehlende_items) > 0) {
return(c(basis, list(
kein_score = TRUE,
warnung_missing = paste0(
"Fehlende Werte bei folgenden Items: ", paste(fehlende_items, collapse = ", "),
". Aus den Quellen liegt keine Regel fuer den Umgang mit fehlenden Werten vor ",
"- es wird daher kein Summenscore berechnet."
)
)))
}
summenscore = sum(item_werte)
schwere = gad7_schweregrad(summenscore)
c(basis, list(
kein_score = FALSE,
warnung_missing = NULL,
summenscore = summenscore,
schwere = schwere,
cutoff_erreicht = summenscore >= 10
))
})
output$fehler_ui = renderUI({
req(input$btn_suchen)
d = ergebnis_r()
if (!is.null(d$error)) div(class = "alert-fehler", d$error)
})
output$warnung_ui = renderUI({
req(input$btn_suchen)
d = ergebnis_r()
if (!is.null(d$error)) return(NULL)
boxen = list()
if (!is.null(d$info_mehrere))
boxen[[length(boxen) + 1]] = div(class = "alert-warnung", d$info_mehrere)
if (isTRUE(d$kein_score) && !is.null(d$warnung_missing))
boxen[[length(boxen) + 1]] = div(class = "alert-warnung", d$warnung_missing)
if (length(boxen) == 0) return(NULL)
tagList(boxen)
})
output$ergebnis_ui = renderUI({
req(input$btn_suchen)
d = ergebnis_r()
if (!is.null(d$error)) return(NULL)
item_vars = names(GAD7_ITEMTEXTE)
items_ui = lapply(item_vars, function(v) {
wert = d$item_werte[[v]]
sk = if (!is.na(wert) && wert >= 0 && wert <= 3) as.character(as.integer(wert)) else NA_character_
item_txt = sub("^\\d+\\.\\s*", "", GAD7_ITEMTEXTE[[v]])
badge = if (!is.na(sk))
span(class = paste0("stufe-badge stufe-badge-", sk), gad7_antwort_text(as.integer(sk)))
else
span(class = "stufe-badge", style = "background:#BDBDBD; color:white;", "fehlend")
div(class = "item-zeile",
div(class = "item-nr", paste0(which(item_vars == v), ".")),
div(class = "item-text", item_txt),
badge
)
})
kopf = div(class = "meta-block",
tags$strong("Chiffre: "), d$chiffre,
tags$span(" | ", style = "color:#ccc;"),
tags$strong("Ausfuelldatum: "), d$datum_str
)
if (isTRUE(d$kein_score)) {
return(div(class = "abschnitt-karte",
div(class = "abschnitt-titel", "GAD-7"),
kopf,
tags$hr(),
tags$h5("GAD-7 Einzelitems"),
div(items_ui)
))
}
schwere = d$schwere
kat_farben = GAD7_SCHWEREGRAD_FARBEN[[schwere$key]]
div(class = "abschnitt-karte",
div(class = "abschnitt-titel", "GAD-7"),
kopf,
tags$hr(),
fluidRow(
column(3,
div(
div(class = "score-zahl", d$summenscore),
div("Summenscore (0-21)", style = "color:#555;"),
div(class = "cutoff-info",
if (isTRUE(d$cutoff_erreicht))
tags$span(style = "color:#B71C1C; font-weight:600;",
paste0(d$summenscore, " >= 10: wahrscheinliche GAD"))
else
tags$span(style = "color:#2E7D32; font-weight:600;",
paste0(d$summenscore, " < 10: Cutoff nicht erreicht"))
)
)
),
column(9, plotOutput("gauge_plot", height = "160px"))
),
tags$hr(),
tags$h5("Schweregrad und diagnostischer Cutoff"),
div(class = "diagnose-box",
style = paste0(
"border-left-color:", kat_farben$text, ";",
"background:", kat_farben$bg, ";",
"color:", kat_farben$text, ";"
),
div(class = "diagnose-titel", paste0("Schweregrad: ", schwere$label)),
div(class = "diagnose-hinweis",
paste0(
"Summenscore ", d$summenscore, " von 21. Diagnostischer Cutoff ",
"(Score >= 10, Sensitivitaet 89%, Spezifitaet 82%, Spitzer et al. 2006): ",
if (isTRUE(d$cutoff_erreicht)) "erreicht (wahrscheinliche GAD)." else "nicht erreicht."
)
),
div(class = "diagnose-disclaimer", GAD7_DISCLAIMER)
),
tags$hr(),
tags$h5("GAD-7 Einzelitems"),
div(items_ui)
)
})
output$gauge_plot = renderPlot({
req(input$btn_suchen)
d = ergebnis_r()
req(is.null(d$error))
req(!isTRUE(d$kein_score))
make_gauge_gad7(d$summenscore)
}, bg = "transparent")
output$download_word = downloadHandler(
filename = function() {
d = tryCatch(ergebnis_r(), error = function(e) NULL)
chiffre = if (is.list(d) && is.null(d$error) && nchar(d$chiffre) > 0)
d$chiffre else "export"
datum = if (is.list(d) && is.null(d$error) && !is.null(d$datum_str))
tryCatch(
format(as.Date(d$datum_str, "%d.%m.%Y"), "%Y%m%d"),
error = function(e) format(Sys.Date(), "%Y%m%d")
)
else
format(Sys.Date(), "%Y%m%d")
paste0("GAD7_", chiffre, "_", datum, ".docx")
},
content = function(file) {
d = tryCatch(ergebnis_r(), error = function(e) NULL)
if (!is.list(d) || !is.null(d$error)) {
doc = read_docx()
doc = body_add_par(doc,
"Kein Datensatz geladen. Bitte zuerst Chiffre oder Pseudonym eingeben und 'Auswerten' klicken.",
style = "Normal")
print(doc, target = file)
return()
}
if (isTRUE(d$kein_score)) {
doc = read_docx()
doc = body_add_par(doc,
paste0("Fuer Chiffre ", d$chiffre, " (", d$datum_str, ") konnte kein Summenscore ",
"berechnet werden: ", d$warnung_missing),
style = "Normal")
print(doc, target = file)
return()
}
doc = tryCatch(
erstelle_gad7_docx(d),
error = function(e) {
err_doc = read_docx()
body_add_par(err_doc,
paste0("Fehler beim Erstellen des Word-Dokuments: ", e$message),
style = "Normal")
}
)
print(doc, target = file)
}
)
}
# Start ####
shinyApp(ui, server)