562 lines
20 KiB
R
562 lines
20 KiB
R
# Präambel ####
|
||
|
||
AKZENT_FARBE = "#8B2635"
|
||
|
||
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_vds31kade.R"
|
||
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"
|
||
|
||
VDS31KADE_DISCLAIMER = paste0(
|
||
"Diese Auswertung stellt eine rein qualitative Zusammenfassung der Selbsteinschaetzung dar. ",
|
||
"Es handelt sich nicht um eine normierte oder klinisch validierte Testauswertung mit ",
|
||
"Cutoff-Werten. Die Interpretation obliegt der behandelnden Person."
|
||
)
|
||
|
||
VDS31KADE_INTERPRETATIONSHINWEIS = paste0(
|
||
"Je groesser ein Balken, umso mehr oder oefter befindet sich in seiner Selbstwahrnehmung ",
|
||
"und im Erleben von Beziehungen der Patient auf der entsprechenden Entwicklungsstufe."
|
||
)
|
||
|
||
KADE_SKALEN = data.frame(
|
||
praefix = c("k", "a", "d", "e"),
|
||
bezeichnung = c("Koerperstufe", "Affektstufe", "Denkenstufe", "Empathiestufe"),
|
||
kurz = c("Koerper", "Affekt", "Denken", "Empathie"),
|
||
stringsAsFactors = FALSE
|
||
)
|
||
|
||
# In formr-Exports meist 'created', kann aber je nach Instanz abweichen. Da zum
|
||
# Buildzeitpunkt kein Live-Datenexport zur Verifikation vorlag, wird zur Laufzeit
|
||
# eine Kandidatenliste geprueft (siehe Server-Abschnitt); ohne Treffer faellt die
|
||
# App auf Sys.Date() zurueck (Anzeige und Word-Dateiname).
|
||
ZEITSTEMPEL_KANDIDATEN = c("created", "ended", "expired", "modified")
|
||
|
||
library(shiny)
|
||
library(dplyr)
|
||
library(ggplot2)
|
||
library(haven)
|
||
library(officer)
|
||
|
||
|
||
# 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 ####
|
||
|
||
# Punktwert (0-3) niemals aus dem Rohwert direkt ableiten, sondern immer aus dem
|
||
# Text des zugehoerigen Labels (beginnt mit "0 = ...", "1 = ...", ...), da der
|
||
# intern gespeicherte Rohwert in dieser formr-Instanz um den Choice-Index
|
||
# verschoben sein kann.
|
||
extrahiere_punktwert = function(spalte, rohwert) {
|
||
labels_attr = attr(spalte, "labels")
|
||
if (is.null(labels_attr) || is.na(rohwert)) return(NA_real_)
|
||
passendes_label = names(labels_attr)[labels_attr == rohwert]
|
||
if (length(passendes_label) == 0) return(NA_real_)
|
||
as.numeric(sub("^([0-9]+).*", "\\1", passendes_label[1]))
|
||
}
|
||
|
||
# check-Items (ausw2/ausw3) sind reine Ja/Nein-Felder, keine Label-Extraktion
|
||
# noetig - robust gegenueber logical, character und numerisch/labelled Rohwerten.
|
||
extrahiere_check_wert = function(wert) {
|
||
if (is.null(wert) || length(wert) == 0) return(NA)
|
||
w = wert[1]
|
||
if (is.na(w)) return(NA)
|
||
if (is.logical(w)) return(as.logical(w))
|
||
if (is.character(w)) {
|
||
wt = trimws(tolower(as.character(w)))
|
||
if (wt %in% c("true", "ja", "1", "wahr")) return(TRUE)
|
||
if (wt %in% c("false", "nein", "0", "falsch")) return(FALSE)
|
||
return(NA)
|
||
}
|
||
wn = suppressWarnings(as.numeric(w))
|
||
if (is.na(wn)) return(NA)
|
||
wn != 0
|
||
}
|
||
|
||
check_text = function(wert) {
|
||
if (is.na(wert)) return("nicht ausgefuellt")
|
||
if (isTRUE(wert)) "Ja" else "Nein"
|
||
}
|
||
|
||
# Skalensumme ueber die 20 Items eines Praefix. Fehlt auch nur ein Item (NA),
|
||
# wird die Summe NICHT stillschweigend aus den uebrigen Items gebildet, sondern
|
||
# als NA ausgewiesen (keine Scheinpraezision) - die Anzeige kennzeichnet das
|
||
# explizit als "Skala unvollstaendig ausgefuellt".
|
||
kade_skala_berechnen = function(daten, zeile, praefix) {
|
||
spalten = paste0("kade_", praefix, "_", sprintf("%02d", 1:20))
|
||
punkte = vapply(spalten, function(sp) {
|
||
extrahiere_punktwert(daten[[sp]], zeile[[sp]][1])
|
||
}, numeric(1))
|
||
vollstaendig = all(!is.na(punkte))
|
||
list(
|
||
summe = if (vollstaendig) sum(punkte) else NA_real_,
|
||
vollstaendig = vollstaendig
|
||
)
|
||
}
|
||
|
||
kade_checks_berechnen = function(zeile, praefix) {
|
||
list(
|
||
ausw2 = extrahiere_check_wert(zeile[[paste0("kade_", praefix, "_ausw2")]]),
|
||
ausw3 = extrahiere_check_wert(zeile[[paste0("kade_", praefix, "_ausw3")]])
|
||
)
|
||
}
|
||
|
||
# Ein Balken je Skala, einheitliche Skalierung 0-60, dezente Gitterlinien alle
|
||
# 5 Punkte als Entsprechung der 12 Fuenf-Punkte-Bereiche des Originalbogens.
|
||
# Keine Farbzonen/Ampel-Codierung - nur die Balkenlaenge zeigt die Auspraegung,
|
||
# graue Balken markieren unvollstaendig ausgefuellte Skalen.
|
||
make_kade_plot = function(skalen_df) {
|
||
df = skalen_df
|
||
df$anzeige_wert = ifelse(is.na(df$summe), 0, df$summe)
|
||
df$label = ifelse(is.na(df$summe), "unvollst.", as.character(df$summe))
|
||
df$skala_f = factor(df$bezeichnung, levels = rev(df$bezeichnung))
|
||
|
||
ggplot(df, aes(x = anzeige_wert, y = skala_f, fill = vollstaendig)) +
|
||
geom_col(width = 0.55, show.legend = FALSE) +
|
||
scale_fill_manual(values = c(`TRUE` = AKZENT_FARBE, `FALSE` = "#BDBDBD")) +
|
||
geom_text(aes(label = label), hjust = -0.15, size = 3.6,
|
||
fontface = "bold", color = "#333333") +
|
||
scale_x_continuous(limits = c(0, 66), breaks = seq(0, 60, by = 5), expand = c(0, 0)) +
|
||
labs(x = "Summenwert (0-60)", y = NULL) +
|
||
theme_minimal(base_size = 12) +
|
||
theme(
|
||
panel.grid.major.x = element_line(color = "#E0E0E0", linewidth = 0.3),
|
||
panel.grid.minor = element_blank(),
|
||
panel.grid.major.y = element_blank(),
|
||
axis.text.y = element_text(face = "bold", color = "#333333", size = 11),
|
||
plot.margin = margin(t = 6, r = 26, b = 6, l = 6)
|
||
)
|
||
}
|
||
|
||
|
||
# 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; }
|
||
.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;
|
||
}
|
||
.item-zeile {
|
||
display: flex; align-items: center; gap: 10px;
|
||
padding: 6px 0; border-bottom: 1px solid #F0F0F0; font-size: 0.92em; color: #333;
|
||
}
|
||
"
|
||
|
||
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("VDS31-KADE – Entwicklungsstufen"),
|
||
tags$p("Koerper-, Affekt-, Denken- und Empathiestufe: 4 Skalen a 20 Items")
|
||
),
|
||
|
||
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_vds31kade_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_hinweis = fp_text(font.size = 10, italic = TRUE, color = "#555555")
|
||
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("VDS31-KADE - Entwicklungsstufen", fp_titel)))
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext("Chiffre: ", fp_label), ftext(erg$chiffre, fp_normal),
|
||
ftext(" Ausfuelldatum: ", fp_label), ftext(erg$ausfuelldatum_str, fp_normal)
|
||
))
|
||
if (!is.null(erg$info_mehrere)) {
|
||
doc = body_add_fpar(doc, fpar(ftext(erg$info_mehrere, fp_hinweis)))
|
||
}
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("Skalenprofil", fp_abschnitt)))
|
||
|
||
bild_tmp = tempfile(fileext = ".png")
|
||
ggsave(bild_tmp, make_kade_plot(erg$skalen), width = 7, height = 3.2, dpi = 150, bg = "white")
|
||
doc = body_add_img(doc, bild_tmp, width = 6.2, height = 2.83)
|
||
unlink(bild_tmp)
|
||
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
doc = body_add_fpar(doc, fpar(ftext(VDS31KADE_INTERPRETATIONSHINWEIS, fp_hinweis)))
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("Skalenwerte im Detail", fp_abschnitt)))
|
||
for (i in seq_len(nrow(erg$skalen))) {
|
||
sk = erg$skalen[i, ]
|
||
ck = erg$checks[[sk$praefix]]
|
||
wert_txt = if (isTRUE(sk$vollstaendig)) paste0(sk$summe, " / 60") else "unvollstaendig ausgefuellt"
|
||
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(paste0(sk$bezeichnung, ": "), fp_label),
|
||
ftext(wert_txt, fp_normal)
|
||
))
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(paste0(" Skala ", sk$bezeichnung, " beschreibt mich ziemlich gut: "), fp_normal),
|
||
ftext(check_text(ck$ausw2), fp_normal)
|
||
))
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(paste0(" Gefuehlsmaessig bin ich eher Typ ", sk$kurz, ": "), fp_normal),
|
||
ftext(check_text(ck$ausw3), fp_normal)
|
||
))
|
||
}
|
||
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
doc = body_add_fpar(doc, fpar(ftext(VDS31KADE_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))
|
||
|
||
if (nchar(trimws(input$pseudonym)) == 0 && nchar(chiffre) == 0) {
|
||
return(list(typ = "fehler", meldung = "Bitte Chiffre oder Pseudonym eingeben."))
|
||
}
|
||
if (nchar(trimws(input$pseudonym)) == 0 && !grepl("^[A-Z][0-9]{6}$", chiffre)) {
|
||
return(list(typ = "fehler", meldung = paste0(
|
||
"Ungueltige Chiffre '", chiffre, "'. Erwartet: ein Grossbuchstabe + 6 Ziffern (z.B. P000123).")))
|
||
}
|
||
|
||
if (!file.exists(PFAD_DOWNLOAD_SKRIPT)) {
|
||
return(list(typ = "fehler", meldung = paste0(
|
||
"Download-Skript nicht gefunden:\n", PFAD_DOWNLOAD_SKRIPT)))
|
||
}
|
||
if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) {
|
||
return(list(typ = "fehler", meldung = paste0(
|
||
"Pseudonym-Skript nicht gefunden:\n", PFAD_PSEUDONYM_SKRIPT)))
|
||
}
|
||
|
||
ok = tryCatch({
|
||
source(PFAD_DOWNLOAD_SKRIPT, local = FALSE)
|
||
list(ok = TRUE)
|
||
}, error = function(e) list(ok = FALSE, msg = e$message))
|
||
if (!ok$ok) return(list(typ = "fehler", meldung = paste0("Fehler im Download-Skript: ", ok$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)
|
||
|
||
ok2 = tryCatch({
|
||
source(PFAD_PSEUDONYM_SKRIPT, local = FALSE)
|
||
list(ok = TRUE)
|
||
}, error = function(e) list(ok = FALSE, msg = e$message))
|
||
if (!ok2$ok) return(list(typ = "fehler", meldung = paste0("Fehler im Pseudonym-Skript: ", ok2$msg)))
|
||
|
||
if (!exists("daten_vds31kade", envir = .GlobalEnv)) {
|
||
return(list(typ = "fehler", meldung = paste0(
|
||
"Objekt 'daten_vds31kade' nach dem Sourcen nicht gefunden. Bitte Download-Skript pruefen.")))
|
||
}
|
||
if (!exists("pseudo", envir = .GlobalEnv)) {
|
||
return(list(typ = "fehler", meldung = paste0(
|
||
"Objekt 'pseudo' nach dem Sourcen nicht gefunden. Bitte Pseudonym-Skript pruefen.")))
|
||
}
|
||
|
||
daten = get("daten_vds31kade", envir = .GlobalEnv)
|
||
pseudo_df = get("pseudo", envir = .GlobalEnv)
|
||
|
||
if (nchar(trimws(input$pseudonym)) > 0) {
|
||
pw_treffer = pseudo_df[pseudo_df$pseudonym == trimws(input$pseudonym), ]
|
||
if (nrow(pw_treffer) > 0) chiffre = toupper(trimws(pw_treffer$chiffre[1]))
|
||
}
|
||
|
||
treffer_ps = pseudo_df[pseudo_df$chiffre == chiffre, ]
|
||
if (nrow(treffer_ps) == 0) {
|
||
return(list(typ = "fehler", meldung = paste0(
|
||
"Chiffre/Pseudonym '", chiffre, "' wurde in der Pseudonym-Datenbank nicht gefunden.")))
|
||
}
|
||
|
||
alle_session_ids = unique(treffer_ps$pseudonym)
|
||
if (nchar(trimws(input$pseudonym)) > 0) alle_session_ids = trimws(input$pseudonym)
|
||
|
||
treffer_dat = daten[daten$session %in% alle_session_ids, ]
|
||
if (nrow(treffer_dat) == 0) {
|
||
return(list(typ = "fehler", meldung = paste0(
|
||
"Keine VDS31-KADE-Fragebogendaten fuer Chiffre/Pseudonym '", chiffre,
|
||
"' gefunden. (", length(alle_session_ids), " Pseudonym(e) geprueft)")))
|
||
}
|
||
|
||
zeitstempel_kandidaten = ZEITSTEMPEL_KANDIDATEN[ZEITSTEMPEL_KANDIDATEN %in% names(treffer_dat)]
|
||
zeitstempel_spalte = if (length(zeitstempel_kandidaten) > 0) zeitstempel_kandidaten[1] else NA_character_
|
||
|
||
info_mehrere = NULL
|
||
if (nrow(treffer_dat) > 1) {
|
||
n = nrow(treffer_dat)
|
||
if (!is.na(zeitstempel_spalte)) {
|
||
treffer_dat = treffer_dat[order(treffer_dat[[zeitstempel_spalte]], decreasing = TRUE), ]
|
||
}
|
||
datum_neu = if (!is.na(zeitstempel_spalte)) {
|
||
tryCatch(format(as.POSIXct(treffer_dat[[zeitstempel_spalte]][1]), "%d.%m.%Y %H:%M"),
|
||
error = function(e) "unbekanntes Datum")
|
||
} else "unbekanntes Datum"
|
||
if (nchar(trimws(input$pseudonym)) == 0) {
|
||
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]
|
||
|
||
ausfuelldatum_str = if (!is.na(zeitstempel_spalte)) {
|
||
tryCatch(
|
||
format(as.POSIXct(zeile[[zeitstempel_spalte]][1]), "%d.%m.%Y"),
|
||
error = function(e) format(Sys.Date(), "%d.%m.%Y") # Fallback: Zeitstempel nicht auswertbar
|
||
)
|
||
} else {
|
||
format(Sys.Date(), "%d.%m.%Y") # Fallback: keine Zeitstempel-Spalte in den Daten gefunden
|
||
}
|
||
|
||
skalen = KADE_SKALEN
|
||
skalen$summe = NA_real_
|
||
skalen$vollstaendig = NA
|
||
checks = list()
|
||
for (i in seq_len(nrow(skalen))) {
|
||
praefix = skalen$praefix[i]
|
||
sk_erg = kade_skala_berechnen(daten, zeile, praefix)
|
||
skalen$summe[i] = sk_erg$summe
|
||
skalen$vollstaendig[i] = sk_erg$vollstaendig
|
||
checks[[praefix]] = kade_checks_berechnen(zeile, praefix)
|
||
}
|
||
|
||
list(
|
||
typ = "ok",
|
||
chiffre = chiffre,
|
||
ausfuelldatum_str = ausfuelldatum_str,
|
||
info_mehrere = info_mehrere,
|
||
skalen = skalen,
|
||
checks = checks
|
||
)
|
||
})
|
||
|
||
output$fehler_ui = renderUI({
|
||
req(input$btn_suchen)
|
||
erg = ergebnis_r()
|
||
if (erg$typ != "ok") div(class = "alert-fehler", erg$meldung)
|
||
})
|
||
|
||
output$warnung_ui = renderUI({
|
||
req(input$btn_suchen)
|
||
erg = ergebnis_r()
|
||
if (erg$typ != "ok" || is.null(erg$info_mehrere)) return(NULL)
|
||
div(class = "alert-warnung", erg$info_mehrere)
|
||
})
|
||
|
||
output$ergebnis_ui = renderUI({
|
||
req(input$btn_suchen)
|
||
erg = ergebnis_r()
|
||
if (erg$typ != "ok") return(NULL)
|
||
|
||
skalen_bloecke = lapply(seq_len(nrow(erg$skalen)), function(i) {
|
||
sk = erg$skalen[i, ]
|
||
ck = erg$checks[[sk$praefix]]
|
||
tagList(
|
||
if (!isTRUE(sk$vollstaendig)) {
|
||
div(style = "color:#BF360C; font-size:0.85em; margin: 8px 0 4px 0;",
|
||
paste0(sk$bezeichnung, ": Skala unvollstaendig ausgefuellt."))
|
||
},
|
||
div(class = "item-zeile",
|
||
div(style = "min-width: 300px;",
|
||
paste0("Skala ", sk$bezeichnung, " beschreibt mich ziemlich gut")),
|
||
div(style = "font-weight:600;", check_text(ck$ausw2))
|
||
),
|
||
div(class = "item-zeile",
|
||
div(style = "min-width: 300px;",
|
||
paste0("Gefuehlsmaessig bin ich eher Typ ", sk$kurz)),
|
||
div(style = "font-weight:600;", check_text(ck$ausw3))
|
||
)
|
||
)
|
||
})
|
||
|
||
div(class = "abschnitt-karte",
|
||
div(class = "abschnitt-titel", "VDS31-KADE – Entwicklungsstufen"),
|
||
|
||
div(style = "color:#555; font-size:0.95em; margin-bottom: 10px;",
|
||
tags$strong("Chiffre: "), erg$chiffre,
|
||
tags$span(" | ", style = "color:#ccc;"),
|
||
tags$strong("Ausfuelldatum: "), erg$ausfuelldatum_str
|
||
),
|
||
|
||
tags$hr(),
|
||
|
||
plotOutput("kade_plot", height = "260px"),
|
||
|
||
div(style = "color:#666; font-size:0.87em; font-style:italic; margin: 10px 0 4px 0;",
|
||
VDS31KADE_INTERPRETATIONSHINWEIS),
|
||
|
||
tags$hr(),
|
||
|
||
tags$h5("Zusatzangaben je Skala"),
|
||
div(skalen_bloecke),
|
||
|
||
tags$hr(),
|
||
|
||
div(style = "font-size:0.82em; color:#777; font-style:italic; margin-top: 10px;",
|
||
VDS31KADE_DISCLAIMER)
|
||
)
|
||
})
|
||
|
||
output$kade_plot = renderPlot({
|
||
req(input$btn_suchen)
|
||
erg = ergebnis_r()
|
||
req(erg$typ == "ok")
|
||
make_kade_plot(erg$skalen)
|
||
}, bg = "transparent")
|
||
|
||
output$download_word = downloadHandler(
|
||
filename = function() {
|
||
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||
daten_ok = is.list(erg) && identical(erg$typ, "ok")
|
||
chiffre_esc = if (daten_ok) gsub("[^A-Za-z0-9]", "", erg$chiffre) else "export"
|
||
ausfuelldatum_fn = if (daten_ok) {
|
||
tryCatch(
|
||
format(as.Date(erg$ausfuelldatum_str, "%d.%m.%Y"), "%Y%m%d"),
|
||
error = function(e) format(Sys.Date(), "%Y%m%d")
|
||
)
|
||
} else format(Sys.Date(), "%Y%m%d")
|
||
paste0("VDS31KADE_", chiffre_esc, "_", ausfuelldatum_fn, ".docx")
|
||
},
|
||
content = function(file) {
|
||
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||
daten_ok = is.list(erg) && identical(erg$typ, "ok")
|
||
if (!daten_ok) {
|
||
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()
|
||
}
|
||
doc = tryCatch(
|
||
erstelle_vds31kade_docx(erg),
|
||
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)
|