server/DiagnostikApps
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Initial commit

Browse source
This commit is contained in:
Jonas Karneboge 2026-09-22 18:35:43 +02:00
commit 3cba772836
1341 changed files with 532924 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

607
FEA Selbst/app.R Normal file
View file

@ -0,0 +1,607 @@
# Präambel ####
AKZENT_FARBE = "#8B2635"
# Tatsaechlicher Dateiname des Download-Skripts vom Nutzer noch zu bestaetigen.
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_fea_selbst.R"
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"
FEA_DISCLAIMER = paste0(
"Dieser Fragebogen (FEA, Doepfner, Lehmkuhl & Steinhausen, 2001) wird hier als reine ",
"Erhebung ohne Auswertung dargestellt. Es liegt keine autorisierte Formel fuer einen ",
"Summenwert, keine Subskalenbildung und kein Cutoff aus der Originalquelle vor. Die farbliche ",
"Kennzeichnung der Antwortstufen dient ausschliesslich der Lesbarkeit der Einzelantworten und ",
"stellt keine klinische Bewertung oder Diagnose dar. Die Interpretation obliegt vollstaendig ",
"der behandelnden Fachperson."
)
ASB_ZEITRAUM_HINWEIS = "Bezieht sich auf die letzten sechs Monate."
FSB_ZEITRAUM_HINWEIS = "Bezieht sich auf die Kindheit, etwa im Alter von 6 bis 12 Jahren."
# Stufe 0-3 (4 Stufen): 0 = gruen, 1 = helles Rosa, 2 = mittleres Rot, 3 = volles Dunkelrot.
FEA_BADGE_FARBEN = c(
"0" = "#4CAF50",
"1" = "#F48FB1",
"2" = "#EF5350",
"3" = "#B71C1C"
)
FEA_BADGE_TEXT_FARBEN = c(
"0" = "white",
"1" = "#333333",
"2" = "white",
"3" = "white"
)
library(shiny)
library(dplyr)
library(haven)
library(officer)
library(DBI)
library(RSQLite)
# 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 ####
# Loest die formr-Backslash-Maskierung ("\." vor der Itemnummer) zu einem
# literalen Punkt auf und entfernt Markdown-Sternchen.
bereinige_text = function(x) {
if (is.null(x) || length(x) == 0 || is.na(x[1])) return(NA_character_)
x = as.character(x[1])
x = gsub("\\*\\*", "", x)
x = gsub("\\.", ".", x, fixed = TRUE)
x
}
# Leitet die Itemnummer aus dem Variablennamen ab, falls das label-Attribut
# nummernfrei ist (fea_asb_01 -> "1", fea_asb_a1 -> "A1").
fea_ableite_nr_aus_varname = function(var_name) {
suffix = sub("^fea_(asb|fsb)_", "", var_name)
if (grepl("^a[0-9]+$", suffix, ignore.case = TRUE)) return(toupper(suffix))
as.character(as.integer(suffix))
}
# Trennt die fuehrende Itemnummer (z.B. "1. " oder "A1. ") vom Fragetext.
# Nummer kommt bevorzugt aus dem bereinigten label-Attribut; falls das
# label-Attribut nummernfrei ist, wird die Nummer aus dem Variablennamen
# abgeleitet.
fea_itemnummer_und_text = function(original_col, var_name) {
raw = bereinige_text(attr(original_col, "label"))
if (is.na(raw)) return(list(nr = fea_ableite_nr_aus_varname(var_name), text = NA_character_))
m = regmatches(raw, regexpr("^(\\d+|[Aa]\\d+)\\.\\s*", raw))
if (length(m) > 0 && nchar(m) > 0) {
nr = toupper(trimws(sub("\\.\\s*$", "", m)))
text = trimws(sub("^(\\d+|[Aa]\\d+)\\.\\s*", "", raw))
return(list(nr = nr, text = text))
}
list(nr = fea_ableite_nr_aus_varname(var_name), text = trimws(raw))
}
# Ordnet einem Rohwert die 0-basierte Stufe zu, ausschliesslich ueber das
# labels-Attribut der ORIGINAL-Spalte (nie hartkodierte Codes).
fea_get_stufe = function(original_col, wert) {
if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) return(NA_integer_)
labels_vec = attr(original_col, "labels")
if (is.null(labels_vec) || length(labels_vec) == 0) return(NA_integer_)
sortiert = labels_vec[order(labels_vec)]
pos = match(as.numeric(wert[1]), sortiert)
if (is.na(pos)) return(NA_integer_)
as.integer(pos - 1L)
}
# Liefert den Antworttext (Stufenname) zu einem Rohwert ueber das
# labels-Attribut der Original-Spalte.
fea_get_stufentext = function(original_col, wert) {
if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) return(NA_character_)
labels_vec = attr(original_col, "labels")
if (is.null(labels_vec) || length(labels_vec) == 0) return(NA_character_)
sortiert = labels_vec[order(labels_vec)]
pos = match(as.numeric(wert[1]), sortiert)
if (is.na(pos)) return(NA_character_)
names(sortiert)[pos]
}
# Sortiert einen Item-Block absteigend nach Stufe (hoechste zuerst),
# nicht beantwortete Items ans Ende, bei Gleichstand aufsteigend nach
# urspruenglicher Position (idx).
fea_sortiere_block = function(items) {
stufen = sapply(items, function(it) it$stufe)
idxs = sapply(items, function(it) it$idx)
reihenfolge = order(is.na(stufen), -ifelse(is.na(stufen), 0L, stufen), idxs)
items[reihenfolge]
}
# Baut die 25 Items (20 Symptom- + 5 Beeintraechtigungsitems) eines
# Abschnitts (Praefix "asb" oder "fsb"). Symptom- und Beeintraechtigungs-
# Items werden je Block getrennt absteigend nach Stufe sortiert, bleiben
# aber als durchlaufende Liste ohne visuelle Absetzung zusammengefuegt.
fea_build_items = function(daten, zeile, praefix) {
symptom_vars = paste0("fea_", praefix, "_", sprintf("%02d", 1:20))
a_vars = paste0("fea_", praefix, "_a", 1:5)
baue_item = function(var, idx) {
original_col = daten[[var]]
wert = zeile[[var]]
nt = fea_itemnummer_und_text(original_col, var)
list(
var = var,
idx = idx,
nr = nt$nr,
text = if (!is.na(nt$text)) nt$text else var,
stufe = fea_get_stufe(original_col, wert),
stufentext = fea_get_stufentext(original_col, wert)
)
}
symptom_items = lapply(seq_along(symptom_vars), function(i) baue_item(symptom_vars[i], i))
a_items = lapply(seq_along(a_vars), function(i) baue_item(a_vars[i], i))
c(fea_sortiere_block(symptom_items), fea_sortiere_block(a_items))
}
fea_get_bemerkung = function(zeile, var) {
wert = zeile[[var]][1]
if (is.null(wert) || is.na(wert) || trimws(as.character(wert)) == "") return(NULL)
trimws(as.character(wert))
}
# 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;
}
.meta-block { margin-bottom: 10px; color: #555; font-size: 0.95em; }
.meta-block strong { color: #222; }
.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: 30px; 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: #F48FB1; color: #333333; }
.stufe-badge-2 { background: #EF5350; color: white; }
.stufe-badge-3 { background: #B71C1C; color: white; }
.stufe-unbeantwortet { color: #888; font-style: italic; font-size: 0.85em; flex-shrink: 0; }
.nav-tabs > li > a { color: #8B2635; font-weight: 600; }
.nav-tabs > li.active > a { color: #8B2635 !important; font-weight: 700; }
"
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("FEA - ADHS-Fragebogen fuer Erwachsene (Eigenbeurteilung)"),
tags$p("Doepfner, Lehmkuhl & Steinhausen 2001 | ASB (aktuell) + FSB (Kindheit)")
),
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_fea_selbst_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 = 9.5, italic = TRUE, color = "#555555")
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
fp_unbeantw = fp_text(italic = TRUE, font.size = 10, color = "#888888")
doc = body_add_fpar(doc, fpar(ftext("FEA - Eigenbeurteilung", 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(FEA_DISCLAIMER, fp_disclaimer)))
doc = body_add_par(doc, "", style = "Normal")
fuege_abschnitt_hinzu = function(doc, titel, zeitraum_hinweis, items, bemerkung) {
doc = body_add_fpar(doc, fpar(ftext(titel, fp_abschnitt)))
doc = body_add_fpar(doc, fpar(ftext(zeitraum_hinweis, fp_hinweis)))
for (item in items) {
sk = if (!is.na(item$stufe) && item$stufe >= 0L && item$stufe <= 3L)
as.character(item$stufe) else NA_character_
if (is.na(sk)) {
doc = body_add_fpar(doc, fpar(
ftext(paste0(item$nr, ". ", item$text, " "), fp_normal),
ftext(" nicht beantwortet ", fp_unbeantw)
))
} else {
fp_badge = fp_text(
color = FEA_BADGE_TEXT_FARBEN[[sk]],
bold = TRUE,
shading.color = FEA_BADGE_FARBEN[[sk]],
font.size = 10
)
doc = body_add_fpar(doc, fpar(
ftext(paste0(item$nr, ". ", item$text, " "), fp_normal),
ftext(paste0(" ", item$stufentext, " "), fp_badge)
))
}
}
if (!is.null(bemerkung)) {
doc = body_add_par(doc, "", style = "Normal")
doc = body_add_fpar(doc, fpar(ftext("Bemerkungen: ", fp_label)))
doc = body_add_par(doc, bemerkung, style = "Normal")
}
doc = body_add_par(doc, "", style = "Normal")
doc
}
doc = fuege_abschnitt_hinzu(doc, "Aktuelle Symptomatik (ASB)", ASB_ZEITRAUM_HINWEIS,
erg$asb$items, erg$asb$bemerkung)
doc = fuege_abschnitt_hinzu(doc, "Kindheit (FSB)", FSB_ZEITRAUM_HINWEIS,
erg$fsb$items, erg$fsb$bemerkung)
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 = "leere_eingabe", meldung = "Bitte Chiffre oder Pseudonym eingeben."))
}
if (nchar(trimws(input$pseudonym)) == 0 && !grepl("^[A-Z][0-9]{6}$", chiffre)) {
return(list(typ = "format_fehler", chiffre = chiffre))
}
if (!file.exists(PFAD_DOWNLOAD_SKRIPT)) {
return(list(typ = "pfad_fehler",
meldung = paste0("Download-Skript nicht gefunden:\n", PFAD_DOWNLOAD_SKRIPT)))
}
if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) {
return(list(typ = "pfad_fehler",
meldung = paste0("Pseudonym-Skript nicht gefunden:\n", PFAD_PSEUDONYM_SKRIPT)))
}
ok_dl = tryCatch({
source(PFAD_DOWNLOAD_SKRIPT, local = FALSE)
list(ok = TRUE)
}, error = function(e) list(ok = FALSE, msg = e$message))
if (!ok_dl$ok) return(list(typ = "skript_fehler", meldung = ok_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)
ok_ps = tryCatch({
source(PFAD_PSEUDONYM_SKRIPT, local = FALSE)
list(ok = TRUE)
}, error = function(e) list(ok = FALSE, msg = e$message))
if (!ok_ps$ok) return(list(typ = "skript_fehler", meldung = ok_ps$msg))
if (!exists("daten_fea_selbst", envir = .GlobalEnv)) {
return(list(typ = "daten_fehlen",
meldung = "Objekt 'daten_fea_selbst' nach dem Sourcen nicht gefunden. Bitte Download-Skript pruefen."))
}
if (!exists("pseudo", envir = .GlobalEnv)) {
return(list(typ = "daten_fehlen",
meldung = "Objekt 'pseudo' nach dem Sourcen nicht gefunden. Bitte Pseudonym-Skript pruefen."))
}
daten = get("daten_fea_selbst", 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 = "kein_treffer",
meldung = paste0("Chiffre '", 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 = "kein_treffer",
meldung = paste0("Kein FEA-Eigenbeurteilung-Datensatz fuer Chiffre '", chiffre, "' gefunden. ",
"(", length(alle_session_ids), " Pseudonym(e) geprueft)")))
}
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]
# Ausfuelldatum aus dem Zeitstempelfeld 'created' der formr-Ergebnisdaten,
# nicht aus Sys.Date().
datum_str = tryCatch(
format(as.POSIXct(zeile[["created"]][1]), "%d.%m.%Y"),
error = function(e) format(Sys.Date(), "%d.%m.%Y")
)
list(
typ = "erfolg",
chiffre = chiffre,
datum_str = datum_str,
info_mehrere = info_mehrere,
asb = list(
items = fea_build_items(daten, zeile, "asb"),
bemerkung = fea_get_bemerkung(zeile, "asb_bemerkungen")
),
fsb = list(
items = fea_build_items(daten, zeile, "fsb"),
bemerkung = fea_get_bemerkung(zeile, "fsb_bemerkungen")
)
)
})
output$fehler_ui = renderUI({
req(input$btn_suchen)
erg = ergebnis_r()
if (erg$typ == "leere_eingabe") {
div(class = "alert-fehler", erg$meldung)
} else if (erg$typ == "format_fehler") {
div(class = "alert-fehler",
paste0("Ungueltige Chiffre '", erg$chiffre, "'. Erwartet: ein Grossbuchstabe + 6 Ziffern (z.B. P000123)."))
} else if (erg$typ == "pfad_fehler") {
div(class = "alert-fehler", erg$meldung)
} else if (erg$typ == "skript_fehler") {
div(class = "alert-fehler", paste0("Fehler beim Ausfuehren eines Skripts: ", erg$meldung))
} else if (erg$typ == "daten_fehlen") {
div(class = "alert-fehler", erg$meldung)
} else if (erg$typ == "kein_treffer") {
div(class = "alert-fehler", erg$meldung)
}
})
output$warnung_ui = renderUI({
req(input$btn_suchen)
erg = ergebnis_r()
if (erg$typ != "erfolg" || 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 != "erfolg") return(NULL)
baue_item_zeile = function(item) {
sk = if (!is.na(item$stufe) && item$stufe >= 0L && item$stufe <= 3L)
as.character(item$stufe) else NA_character_
badge = if (is.na(sk)) {
span(class = "stufe-unbeantwortet", "nicht beantwortet")
} else {
span(class = paste0("stufe-badge stufe-badge-", sk), item$stufentext)
}
div(class = "item-zeile",
div(class = "item-nr", paste0(item$nr, ".")),
div(class = "item-text", item$text),
badge
)
}
baue_abschnitt = function(titel, zeitraum_hinweis, items, bemerkung) {
tabPanel(titel,
div(style = "padding-top: 16px;",
div(class = "meta-block", zeitraum_hinweis),
lapply(items, baue_item_zeile),
if (!is.null(bemerkung)) tagList(
tags$hr(),
div(class = "meta-block", tags$strong("Bemerkungen:")),
div(style = "white-space: pre-wrap; color:#333; font-size:0.92em;", bemerkung)
)
)
)
}
div(class = "abschnitt-karte",
div(class = "abschnitt-titel", "FEA - Eigenbeurteilung"),
div(class = "meta-block",
tags$strong("Chiffre: "), erg$chiffre,
tags$span(" | ", style = "color:#ccc;"),
tags$strong("Ausfuelldatum: "), erg$datum_str
),
div(class = "alert-warnung", FEA_DISCLAIMER),
tags$hr(),
tabsetPanel(
baue_abschnitt("Aktuelle Symptomatik (ASB)", ASB_ZEITRAUM_HINWEIS, erg$asb$items, erg$asb$bemerkung),
baue_abschnitt("Kindheit (FSB)", FSB_ZEITRAUM_HINWEIS, erg$fsb$items, erg$fsb$bemerkung)
)
)
})
output$download_word = downloadHandler(
filename = function() {
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
chiffre = if (is.list(erg) && identical(erg$typ, "erfolg") && nchar(erg$chiffre) > 0)
erg$chiffre else "export"
datum = if (is.list(erg) && identical(erg$typ, "erfolg") && !is.null(erg$datum_str))
tryCatch(
format(as.Date(erg$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("FEA_selbst_", chiffre, "_", datum, ".docx")
},
content = function(file) {
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
daten_ok = is.list(erg) && identical(erg$typ, "erfolg")
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_fea_selbst_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)