DiagnostikApps/FEA Fremd/app.R

# Präambel ####

AKZENT_FARBE = "#8B2635"

# HINWEIS: tatsaechlichen Dateinamen des Download-Skripts beim ersten Lauf pruefen,
# ggf. Pfad anpassen (Nutzer legt das Skript ausserhalb dieses Verzeichnisses an).
PFAD_DOWNLOAD_SKRIPT  = "../API/get_data_fea_fremd.R"    # liefert: daten_fea_fremd
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"            # liefert: pseudo

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. Es handelt sich zudem um eine ",
  "Fremdbeurteilung durch eine dritte Person, nicht um eine Selbstauskunft der betroffenen ",
  "Person. Die Interpretation obliegt vollstaendig der behandelnden Fachperson."
)

FEA_AFB_HINWEIS = "Beurteilungszeitraum: die letzten sechs Monate."
FEA_FFB_HINWEIS = "Beurteilungszeitraum: Kindheit, im Alter von etwa 6 bis 12 Jahren."

# Verlauf gruen -> dunkelrot entspricht den 4 Antwortstufen 0-3.
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"
)
FEA_STUFEN_TEXTE = c("gar nicht", "ein wenig", "weitgehend", "besonders")

library(shiny)
library(dplyr)
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 ####

# Itemnummer aus dem Variablennamen ableiten (Fallback, falls das label-Attribut
# keine Nummerierung enthaelt): fea_afb_01 -> "1", fea_afb_a1 -> "A1".
fea_item_nr_from_varname = function(var_name) {
  suffix = sub("^fea_(afb|ffb)_", "", var_name)
  if (grepl("^a[0-9]+$", suffix, ignore.case = TRUE)) return(toupper(suffix))
  as.character(as.integer(suffix))
}

# Bereinigt das label-Attribut (maskierter Punkt "\." als Exportartefakt) und
# trennt die fuehrende Itemnummer ("1. ", "A1. ") vom reinen Fragetext ab.
# Falls kein Nummern-Praefix im Text steht, wird die Nummer aus dem Variablennamen abgeleitet.
fea_clean_and_split_label = function(raw_label, var_name) {
  nr_fallback = fea_item_nr_from_varname(var_name)
  if (is.null(raw_label) || length(raw_label) == 0 || is.na(raw_label[1])) {
    return(list(nr = nr_fallback, text = NA_character_))
  }
  txt = as.character(raw_label[1])
  txt = gsub("\\\\\\.", ".", txt)
  txt = trimws(txt)

  praefix = regmatches(txt, regexpr("^(\\d+|A\\d+)\\.\\s*", txt))
  if (length(praefix) > 0 && nchar(praefix) > 0) {
    nr   = sub("\\.\\s*$", "", praefix)
    rest = sub("^(\\d+|A\\d+)\\.\\s*", "", txt)
    return(list(nr = nr, text = rest))
  }
  list(nr = nr_fallback, text = txt)
}

# labels-Attribut der ORIGINAL-Spalte (vor Subsetting) lesen, damit die
# Zuordnung Wert -> Stufe (0-3) immer aus den Daten selbst stammt, nie hartkodiert.
fea_get_level = function(original_col, wert) {
  if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) return(NA_integer_)
  lbl_attr = attr(original_col, "labels")
  if (!is.null(lbl_attr) && length(lbl_attr) > 0) {
    lbl_sortiert = sort(as.vector(lbl_attr))
    pos = which(lbl_sortiert == as.numeric(wert[1]))
    if (length(pos) > 0) return(as.integer(pos[1]) - 1L)
  }
  # Fallback bei fehlenden labels: 1-basierte Kodierung angenommen
  as.integer(as.numeric(wert[1])) - 1L
}

fea_get_anker = function(original_col, wert) {
  if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) return(NA_character_)
  lbl_attr = attr(original_col, "labels")
  if (!is.null(lbl_attr) && length(lbl_attr) > 0) {
    pos = which(as.vector(lbl_attr) == as.numeric(wert[1]))
    if (length(pos) > 0) return(names(lbl_attr)[pos[1]])
  }
  stufe = max(0L, min(3L, as.integer(as.numeric(wert[1])) - 1L))
  FEA_STUFEN_TEXTE[stufe + 1L]
}

# Sortiert eine Item-Gruppe absteigend nach Stufe (3 = "besonders" zuerst).
# Nicht beantwortete Items (NA) stehen unabhaengig von der Sortierrichtung am Ende.
fea_sort_by_stufe = function(items) {
  if (length(items) == 0) return(items)
  stufen = sapply(items, function(it) it$stufe)
  ord    = order(is.na(stufen), -ifelse(is.na(stufen), 0L, stufen))
  items[ord]
}

# Liest alle 25 Items (20 Symptom- + 5 Beeintraechtigungsitems, A1-A5 optional/NA-faehig)
# eines Abschnitts (prefix = "fea_afb" oder "fea_ffb") aus der Original-Datenzeile.
# Symptom- und Beeintraechtigungsitems werden getrennt voneinander nach Stufe sortiert
# (zwei Bloecke, kein Vermischen), die Zweiteilung selbst bleibt dabei bestehen.
fea_extract_section = function(daten, zeile, prefix) {
  symptom_vars = sprintf("%s_%02d", prefix, 1:20)
  impair_vars  = sprintf("%s_a%d", prefix, 1:5)

  lese_items = function(vars) {
    lapply(vars, function(var) {
      original_col = daten[[var]]
      wert         = zeile[[var]]
      raw_label    = attr(original_col, "label")
      teile        = fea_clean_and_split_label(raw_label, var)
      list(
        var   = var,
        nr    = teile$nr,
        text  = if (!is.na(teile$text)) teile$text else var,
        stufe = fea_get_level(original_col, wert),
        anker = fea_get_anker(original_col, wert)
      )
    })
  }

  c(
    fea_sort_by_stufe(lese_items(symptom_vars)),
    fea_sort_by_stufe(lese_items(impair_vars))
  )
}

fea_fehlermeldung = function(err) {
  if (is.null(err)) return(NULL)
  switch(err$typ,
    "format_fehler" = paste0(
      "Ungueltige Chiffre '", err$chiffre, "'. Erwartet: ein Grossbuchstabe + 6 Ziffern ",
      "(z.B. P000123)."),
    err$meldung
  )
}


# 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; }
.disclaimer-block {
  background: #F5F5F5; border-left: 5px solid #8B2635;
  padding: 10px 16px; border-radius: 4px; color: #555;
  font-size: 0.85em; font-style: italic; margin-bottom: 16px; line-height: 1.5;
}
.zeitraum-hinweis {
  color: #555; font-size: 0.9em; font-style: italic; margin-bottom: 12px;
}
.bemerkungen-block {
  margin-top: 14px; background: #FAFAFA; border-radius: 6px;
  padding: 12px 16px; border: 1px solid #EEE;
}
.bemerkungen-block strong { color: #333; }
.bemerkungen-block p { white-space: pre-wrap; margin: 6px 0 0; color: #444; }
.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; }
.item-unbeantwortet {
  color: #999; font-style: italic; font-size: 0.85em; white-space: nowrap; flex-shrink: 0;
}
.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; }
"

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 – Fremdbeurteilung"),
    tags$p("ADHS-Fragebogen fuer Erwachsene, Fremdbeurteilungsversion | Doepfner, Lehmkuhl & Steinhausen 2001")
  ),

  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 ####

fea_item_par_word = function(item, fp_normal) {
  nr_text = paste0(item$nr, ". ", item$text, "  ")
  if (is.na(item$stufe)) {
    fp_na = fp_text(font.size = 10, italic = TRUE, color = "#888888")
    return(fpar(ftext(nr_text, fp_normal), ftext(" nicht beantwortet ", fp_na)))
  }
  sk        = as.character(item$stufe)
  anker_txt = if (!is.na(item$anker)) item$anker else FEA_STUFEN_TEXTE[item$stufe + 1L]
  fp_badge  = fp_text(
    color         = FEA_BADGE_TEXT_FARBEN[[sk]],
    bold          = TRUE,
    shading.color = FEA_BADGE_FARBEN[[sk]],
    font.size     = 10
  )
  fpar(ftext(nr_text, fp_normal), ftext(paste0(" ", anker_txt, " "), fp_badge))
}

fea_add_section_word = function(doc, titel, hinweis, items, bemerkungen,
                                 fp_abschnitt, fp_normal, fp_hinweis, fp_label) {
  doc = body_add_fpar(doc, fpar(ftext(titel, fp_abschnitt)))
  doc = body_add_fpar(doc, fpar(ftext(hinweis, fp_hinweis)))

  for (item in items) {
    doc = body_add_fpar(doc, fea_item_par_word(item, fp_normal))
  }

  if (!is.null(bemerkungen) && nchar(trimws(bemerkungen)) > 0) {
    doc = body_add_par(doc, "", style = "Normal")
    doc = body_add_fpar(doc, fpar(ftext("Bemerkungen:", fp_label)))
    doc = body_add_par(doc, bemerkungen, style = "Normal")
  }
  doc = body_add_par(doc, "", style = "Normal")
  doc
}

erstelle_fea_fremd_docx = function(erg) {
  doc = read_docx()

  fp_titel      = fp_text(color = AKZENT_FARBE, bold = TRUE,  font.size = 18)
  fp_meta_label = fp_text(color = AKZENT_FARBE, bold = TRUE,  font.size = 11)
  fp_meta       = fp_text(color = AKZENT_FARBE, bold = FALSE, font.size = 11)
  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("FEA — Fremdbeurteilung", fp_titel)))
  doc = body_add_fpar(doc, fpar(
    ftext("Chiffre: ",    fp_meta_label),
    ftext(erg$chiffre,    fp_meta),
    ftext("     Ausfuelldatum: ", fp_meta_label),
    ftext(erg$datum_str,  fp_meta)
  ))
  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(FEA_DISCLAIMER, fp_disclaimer)))
  doc = body_add_par(doc, "", style = "Normal")

  doc = fea_add_section_word(
    doc, "Aktuelle Symptomatik (AFB)", FEA_AFB_HINWEIS,
    erg$afb_items, erg$afb_bemerkungen,
    fp_abschnitt, fp_normal, fp_hinweis, fp_label
  )

  doc = fea_add_section_word(
    doc, "Kindheit (FFB)", FEA_FFB_HINWEIS,
    erg$ffb_items, erg$ffb_bemerkungen,
    fp_abschnitt, fp_normal, fp_hinweis, fp_label
  )

  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.
  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 = "skript_fehler", meldung = paste0(
        "Download-Skript nicht gefunden:\n", PFAD_DOWNLOAD_SKRIPT)))
    }
    if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) {
      return(list(typ = "skript_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 = "skript_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)

    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 = paste0("Fehler im Pseudonym-Skript: ", ok_ps$msg)))
    }

    if (!exists("daten_fea_fremd", envir = .GlobalEnv)) {
      return(list(typ = "skript_fehler", meldung = paste0(
        "Objekt 'daten_fea_fremd' nach dem Sourcen nicht gefunden. Bitte Download-Skript pruefen.")))
    }
    if (!exists("pseudo", envir = .GlobalEnv)) {
      return(list(typ = "skript_fehler", meldung = paste0(
        "Objekt 'pseudo' nach dem Sourcen nicht gefunden. Bitte Pseudonym-Skript pruefen.")))
    }

    daten     = get("daten_fea_fremd", envir = .GlobalEnv)
    pseudo_df = get("pseudo",          envir = .GlobalEnv)

    # Chiffre aus Pseudonym zurueckaufloesen, falls ein Pseudonym eingegeben wurde.
    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 = "keine_chiffre_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 = "keine_daten_treffer", meldung = paste0(
        "Kein FEA-Fremdbeurteilungs-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]
    datum_str = tryCatch(
      format(as.POSIXct(zeile[["created"]][1]), "%d.%m.%Y"),
      error = function(e) format(Sys.Date(), "%d.%m.%Y")
    )

    afb_items = fea_extract_section(daten, zeile, "fea_afb")
    ffb_items = fea_extract_section(daten, zeile, "fea_ffb")

    afb_bemerkungen = as.character(zeile[["afb_bemerkungen"]][1])
    ffb_bemerkungen = as.character(zeile[["ffb_bemerkungen"]][1])
    if (is.na(afb_bemerkungen)) afb_bemerkungen = ""
    if (is.na(ffb_bemerkungen)) ffb_bemerkungen = ""

    list(
      chiffre         = chiffre,
      datum_str       = datum_str,
      info_mehrere    = info_mehrere,
      afb_items       = afb_items,
      ffb_items       = ffb_items,
      afb_bemerkungen = afb_bemerkungen,
      ffb_bemerkungen = ffb_bemerkungen,
      typ             = NULL
    )
  })

  output$fehler_ui = renderUI({
    req(input$btn_suchen)
    d = ergebnis_r()
    if (!is.null(d$typ)) {
      div(class = "alert-fehler", fea_fehlermeldung(d))
    }
  })

  output$warnung_ui = renderUI({
    req(input$btn_suchen)
    d = ergebnis_r()
    if (!is.null(d$typ) || is.null(d$info_mehrere)) return(NULL)
    div(class = "alert-warnung", d$info_mehrere)
  })

  fea_item_row_ui = function(item) {
    if (is.na(item$stufe)) {
      return(div(class = "item-zeile",
        div(class = "item-nr",   paste0(item$nr, ".")),
        div(class = "item-text", item$text),
        span(class = "item-unbeantwortet", "nicht beantwortet")
      ))
    }
    sk        = as.character(item$stufe)
    anker_txt = if (!is.na(item$anker)) item$anker else FEA_STUFEN_TEXTE[item$stufe + 1L]
    div(class = "item-zeile",
      div(class = "item-nr",   paste0(item$nr, ".")),
      div(class = "item-text", item$text),
      span(class = paste0("stufe-badge stufe-badge-", sk), anker_txt)
    )
  }

  fea_section_ui = function(hinweis, items, bemerkungen) {
    tagList(
      div(class = "zeitraum-hinweis", hinweis),
      div(lapply(items, fea_item_row_ui)),
      if (nchar(trimws(bemerkungen)) > 0) {
        div(class = "bemerkungen-block",
          tags$strong("Bemerkungen:"),
          tags$p(bemerkungen)
        )
      }
    )
  }

  output$ergebnis_ui = renderUI({
    req(input$btn_suchen)
    d = ergebnis_r()
    if (!is.null(d$typ)) return(NULL)

    div(class = "abschnitt-karte",
      div(class = "abschnitt-titel", "FEA — Fremdbeurteilung"),

      div(class = "meta-block",
        tags$strong("Chiffre: "), d$chiffre,
        tags$span("   |   ", style = "color:#ccc;"),
        tags$strong("Ausfuelldatum: "), d$datum_str
      ),

      div(class = "disclaimer-block", FEA_DISCLAIMER),

      tabsetPanel(
        tabPanel("Aktuelle Symptomatik (AFB)",
          div(style = "margin-top: 14px;",
            fea_section_ui(FEA_AFB_HINWEIS, d$afb_items, d$afb_bemerkungen)
          )
        ),
        tabPanel("Kindheit (FFB)",
          div(style = "margin-top: 14px;",
            fea_section_ui(FEA_FFB_HINWEIS, d$ffb_items, d$ffb_bemerkungen)
          )
        )
      )
    )
  })

  output$download_word = downloadHandler(
    filename = function() {
      d       = tryCatch(ergebnis_r(), error = function(e) NULL)
      chiffre = if (is.list(d) && is.null(d$typ) && nchar(d$chiffre) > 0)
        d$chiffre else "export"
      datum   = if (is.list(d) && is.null(d$typ) && !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("FEA_fremd_", chiffre, "_", datum, ".docx")
    },
    content = function(file) {
      d        = tryCatch(ergebnis_r(), error = function(e) NULL)
      daten_ok = is.list(d) && is.null(d$typ)
      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_fremd_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)