# Präambel ####

AKZENT_FARBE = "#8B2635"

PFAD_DOWNLOAD_SKRIPT  = "../API/get_data_soms2.R"    # liefert: daten_soms2
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"        # liefert: pseudo

PFAD_NORM_A1 = "normen/soms2_norm_a1_gesunde.csv"
PFAD_NORM_A2 = "normen/soms2_norm_a2_patienten.csv"

SOMS2_ROHWERT_MAX_A1 = 20
SOMS2_ROHWERT_MAX_A2 = 40

SOMS2_DISCLAIMER = paste0(
  "Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
  "keine klinische Diagnose. Die Interpretation obliegt der behandelnden Person."
)

SOMS2_BESCHWERDEN_CUTOFF_HINWEIS = paste0(
  "Ab einem Beschwerdenindex von mindestens 7 im SOMS-2 kann in der Regel von ",
  "einem starken, beeintraechtigenden Somatisierungssyndrom ausgegangen werden."
)

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)
PFAD_NORM_A1          = normalizePath(absPath(PFAD_NORM_A1),          mustWork = FALSE)
PFAD_NORM_A2          = normalizePath(absPath(PFAD_NORM_A2),          mustWork = FALSE)


# Helper ####

# Generischer Label-Text-Lookup ueber das labels-Attribut der ORIGINAL-Spalte
# (vor Subsetting), damit die Zuordnung Wert -> Text immer aus den Daten selbst
# stammt und nie von der konkreten formr-Rohkodierung abhaengt.
soms2_get_label_text = 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(trimws(names(lbl_attr)[pos[1]]))
  }
  NA_character_
}

# Ordinalrang (0-basiert) ueber die sortierte Position im labels-Attribut,
# unabhaengig von der tatsaechlichen formr-Kodierung. Genutzt fuer soms2_54
# (0 = "keinmal" ... 4 = "mehr als 12 mal") und soms2_63
# (0 = "unter 6 Monate" ... 3 = "ueber 2 Jahre").
soms2_ordinal_rang = 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)
  }
  NA_integer_
}

# TRUE nur bei eindeutigem "ja"-Label. NA/fehlend (u.a. showif-bedingtes NA bei
# geschlechtsspezifischen Items) wird als "nein" gewertet, nie als Fehler - das
# ist fuer die Summenscores korrekt, weil solche Items ohnehin ueber den
# dynamischen Maximalwert aus der Zaehlung herausgenommen werden.
soms2_ist_ja = function(original_col, wert) {
  txt = soms2_get_label_text(original_col, wert)
  if (is.na(txt)) return(FALSE)
  if (grepl("nein", txt, ignore.case = TRUE)) return(FALSE)
  grepl("ja", txt, ignore.case = TRUE)
}

# TRUE nur bei explizitem "nein"-Label. Anders als soms2_ist_ja() liefert dies
# bei NA FALSE zurueck (Kriterium "Antwort = nein" gilt bei fehlender Antwort
# als nicht erfuellt, nicht automatisch als erfuellt).
soms2_ist_nein = function(original_col, wert) {
  txt = soms2_get_label_text(original_col, wert)
  if (is.na(txt)) return(FALSE)
  grepl("nein", txt, ignore.case = TRUE)
}

# Geschlecht ausschliesslich ueber das labels-Attribut/den Text abgleichen, nie
# ueber hartkodierte Zahlenwerte 1/2 (Kodierung kann je Setup variieren).
soms2_geschlecht_text = function(original_col, wert) {
  txt = soms2_get_label_text(original_col, wert)
  if (is.na(txt)) return(NA_character_)
  txt_l = tolower(txt)
  if (grepl("weib", txt_l)) return("weiblich")
  if (grepl("männ|maenn", txt_l)) return("maennlich")
  NA_character_
}

# Entfernt Markdown-Escapes ("1\. Text" -> "1. Text", so liegt das label-
# Attribut in der soms2.xlsx vor) und danach die fuehrende Itemnummer samt
# Trennzeichen (z.B. "1. " oder "01) ").
soms2_clean_item_text = function(text) {
  if (is.null(text) || length(text) == 0 || is.na(text[1])) return(NA_character_)
  txt = gsub("\\.", ".", trimws(as.character(text[1])), fixed = TRUE)
  trimws(sub("^\\d+[.):]?\\s*", "", txt))
}

# Klartext-Fragetext eines Items, Fallback auf den Variablennamen, falls kein
# label-Attribut vorhanden ist (z.B. bei einem unvollstaendigen Test-Stub).
soms2_item_text = function(daten, item) {
  txt = soms2_clean_item_text(attr(daten[[item]], "label"))
  if (is.na(txt)) item else txt
}

# Baut einen Kriteriumsbestandteil: Fragetext, tatsaechlich gegebene Antwort
# (Klartext ueber das labels-Attribut) und geforderte Antwort/Kategorie.
soms2_kriterium_teil = function(zeile, daten, item, erforderlich) {
  antwort = soms2_get_label_text(daten[[item]], zeile[[item]])
  list(
    text        = soms2_item_text(daten, item),
    antwort     = if (is.na(antwort)) "k. A." else antwort,
    erforderlich = erforderlich
  )
}

# Zaehlt "ja"-Antworten ueber eine einfache Itemliste (DSM-IV, Beschwerdenindex).
soms2_score_items = function(zeile, daten, items) {
  sum(vapply(items, function(it) soms2_ist_ja(daten[[it]], zeile[[it]]), logical(1)))
}

# Zaehlt Wertungseinheiten: jede Gruppe (ODER-Verknuepfung mehrerer Items)
# zaehlt maximal 1 Punkt, auch wenn mehrere Items darin "ja" sind
# (ICD-10-Somatisierungsindex, SAD-Index).
soms2_score_einheiten = function(zeile, daten, einheiten) {
  sum(vapply(einheiten, function(gruppe) {
    any(vapply(gruppe, function(it) soms2_ist_ja(daten[[it]], zeile[[it]]), logical(1)))
  }, logical(1)))
}

# Prozentrang-Lookup: exakter Rohwert-Match; Rohwerte oberhalb des
# Tabellenmaximums erhalten Prozentrang 100 (alle Indizes erreichen dort
# bereits 100 in der jeweiligen Norm). Ohne exakten Treffer (sollte bei
# Ganzzahl-Scores nicht vorkommen) wird auf den naechstniedrigeren
# Tabelleneintrag geruendet.
soms2_prozentrang = function(rohwert, norm_tab, spalte, rohwert_max) {
  if (is.null(rohwert) || length(rohwert) == 0 || is.na(rohwert)) return(NA_integer_)
  if (rohwert > rohwert_max) return(100L)
  treffer = norm_tab[norm_tab$rohwert == rohwert, ]
  if (nrow(treffer) == 0) {
    kandidaten = norm_tab[norm_tab$rohwert <= rohwert, ]
    if (nrow(kandidaten) == 0) return(NA_integer_)
    treffer = kandidaten[which.max(kandidaten$rohwert), ]
  }
  as.numeric(treffer[[spalte]][1])
}

# Ermittelt Prozentrang (+ optionale Gesamtnorm-Referenz bei A-1) fuer einen
# Index, abhaengig von der gewaehlten Vergleichsnorm und dem Geschlecht.
soms2_pr_ergebnis = function(index_key, rohwert, geschlecht, normwahl, norm_a1, norm_a2) {
  if (identical(normwahl, "patienten")) {
    spalte = SOMS2_NORM_SPALTEN_A2[[index_key]]
    pr = soms2_prozentrang(rohwert, norm_a2, spalte, SOMS2_ROHWERT_MAX_A2)
    return(list(pr = pr, pr_gesamt = NA_integer_))
  }
  spalten = SOMS2_NORM_SPALTEN_A1[[index_key]]
  geschlecht_spalte = if (identical(geschlecht, "weiblich")) spalten$w
    else if (identical(geschlecht, "maennlich")) spalten$m
    else spalten$gesamt
  pr        = soms2_prozentrang(rohwert, norm_a1, geschlecht_spalte, SOMS2_ROHWERT_MAX_A1)
  pr_gesamt = soms2_prozentrang(rohwert, norm_a1, spalten$gesamt,    SOMS2_ROHWERT_MAX_A1)
  list(pr = pr, pr_gesamt = pr_gesamt)
}

# Dynamische Maximalwerte (Abschnitt 4): unbekanntes/fehlendes Geschlecht faellt
# konservativ auf den vollen (nicht reduzierten) Maximalwert zurueck.
soms2_dsmiv_max = function(geschlecht) {
  if (identical(geschlecht, "weiblich"))  return(33L - 1L)
  if (identical(geschlecht, "maennlich")) return(33L - 4L)
  33L
}
soms2_icd10_max = function(geschlecht) {
  if (identical(geschlecht, "maennlich")) return(13L)
  14L
}
soms2_beschwerden_max = function(geschlecht) {
  # Beschwerdenindex umfasst alle 53 Items (anders als DSM-IV, das soms2_52
  # gar nicht enthaelt): bei Maennern sind soms2_48-52 (5 Items) nicht
  # anwendbar, bei Frauen nur soms2_53 (1 Item).
  if (identical(geschlecht, "weiblich"))  return(53L - 1L)
  if (identical(geschlecht, "maennlich")) return(53L - 5L)
  53L
}

# Jedes Kriterium traegt seine Bestandteile (teile - i.d.R. 1, bei der
# ODER-Verknuepfung in Kriterium 1 des DSM-IV-Index 2) mit dem tatsaechlichen
# Fragetext + der gegebenen Antwort, damit UI und Word-Export die konkrete
# Item-Formulierung statt einer blossen Itemnummer anzeigen koennen.
soms2_dsmiv_kriterien = function(zeile, daten) {
  rang54 = soms2_ordinal_rang(daten[["soms2_54"]], zeile[["soms2_54"]])
  rang63 = soms2_ordinal_rang(daten[["soms2_63"]], zeile[["soms2_63"]])
  list(
    list(
      teile = list(
        soms2_kriterium_teil(zeile, daten, "soms2_54", "nicht 'keinmal'"),
        soms2_kriterium_teil(zeile, daten, "soms2_58", "ja")
      ),
      verknuepfung = "ODER",
      erfuellt = (!is.na(rang54) && rang54 != 0L) ||
                 soms2_ist_ja(daten[["soms2_58"]], zeile[["soms2_58"]])
    ),
    list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_55", "nein")),
         verknuepfung = NULL,
         erfuellt = soms2_ist_nein(daten[["soms2_55"]], zeile[["soms2_55"]])),
    list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_62", "ja")),
         verknuepfung = NULL,
         erfuellt = soms2_ist_ja(daten[["soms2_62"]], zeile[["soms2_62"]])),
    list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_63", "'ueber 2 Jahre'")),
         verknuepfung = NULL,
         erfuellt = !is.na(rang63) && rang63 == 3L)
  )
}

soms2_icd10_kriterien = function(zeile, daten) {
  rang54 = soms2_ordinal_rang(daten[["soms2_54"]], zeile[["soms2_54"]])
  rang63 = soms2_ordinal_rang(daten[["soms2_63"]], zeile[["soms2_63"]])
  list(
    list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_54", "mindestens '3 bis 6 mal'")),
         verknuepfung = NULL, erfuellt = !is.na(rang54) && rang54 >= 2L),
    list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_55", "nein")),
         verknuepfung = NULL, erfuellt = soms2_ist_nein(daten[["soms2_55"]], zeile[["soms2_55"]])),
    list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_56", "nein")),
         verknuepfung = NULL, erfuellt = soms2_ist_nein(daten[["soms2_56"]], zeile[["soms2_56"]])),
    list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_57", "ja")),
         verknuepfung = NULL, erfuellt = soms2_ist_ja(daten[["soms2_57"]], zeile[["soms2_57"]])),
    list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_61", "nein")),
         verknuepfung = NULL, erfuellt = soms2_ist_nein(daten[["soms2_61"]], zeile[["soms2_61"]])),
    list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_63", "'ueber 2 Jahre'")),
         verknuepfung = NULL, erfuellt = !is.na(rang63) && rang63 == 3L)
  )
}

soms2_sad_kriterien = function(zeile, daten) {
  list(
    list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_55", "nein")),
         verknuepfung = NULL, erfuellt = soms2_ist_nein(daten[["soms2_55"]], zeile[["soms2_55"]])),
    list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_61", "nein")),
         verknuepfung = NULL, erfuellt = soms2_ist_nein(daten[["soms2_61"]], zeile[["soms2_61"]]))
  )
}


# Datenaufbereitung ####

if (!file.exists(PFAD_NORM_A1)) {
  stop(paste0(
    "Normtabelle (Gesunde) nicht gefunden: ", PFAD_NORM_A1,
    ". Bitte die Datei soms2_norm_a1_gesunde.csv in den Unterordner 'normen/' legen."
  ))
}
if (!file.exists(PFAD_NORM_A2)) {
  stop(paste0(
    "Normtabelle (Patienten) nicht gefunden: ", PFAD_NORM_A2,
    ". Bitte die Datei soms2_norm_a2_patienten.csv in den Unterordner 'normen/' legen."
  ))
}

soms2_norm_a1 = read.csv(PFAD_NORM_A1, stringsAsFactors = FALSE)
soms2_norm_a2 = read.csv(PFAD_NORM_A2, stringsAsFactors = FALSE)

# Somatisierungsindex DSM-IV: 33 Items, soms2_53 nur bei Frauen erhoben,
# soms2_48-51 nur bei Maennern erhoben (showif in formr).
SOMS2_DSMIV_ITEMS = sprintf("soms2_%02d", c(
  1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 16, 20, 32, 34, 35,
  36, 37, 38, 39, 40, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 53
))

# Somatisierungsindex ICD-10: 14 Wertungseinheiten (ODER-Gruppen), Einheit 14
# (soms2_52) nur bei Frauen anwendbar.
SOMS2_ICD10_EINHEITEN = list(
  "soms2_02",
  c("soms2_04", "soms2_05"),
  "soms2_06",
  c("soms2_09", "soms2_22", "soms2_38"),
  "soms2_10",
  "soms2_11",
  c("soms2_13", "soms2_14"),
  "soms2_18",
  c("soms2_20", "soms2_21"),
  "soms2_28",
  "soms2_31",
  "soms2_33",
  c("soms2_40", "soms2_41"),
  "soms2_52"
)

# SAD-Index ICD-10: 12 Wertungseinheiten, keine Geschlechtertrennung.
SOMS2_SAD_EINHEITEN = list(
  c("soms2_06", "soms2_25"),
  "soms2_11",
  "soms2_12",
  "soms2_15",
  "soms2_19",
  c("soms2_09", "soms2_22", "soms2_38"),
  "soms2_23",
  "soms2_24",
  "soms2_26",
  "soms2_27",
  c("soms2_28", "soms2_29"),
  "soms2_30"
)

# Beschwerdenindex Somatisierung: alle Items soms2_01-soms2_53, keine Auswahl.
SOMS2_BESCHWERDEN_ITEMS = sprintf("soms2_%02d", 1:53)

# Zusatz-Screeningitems 64-68: 65/67 sind Folgefragen zu 64/66, 68 steht
# alleine. Reine Einzelitem-Anzeige, kein Score.
SOMS2_ZUSATZ_ITEMS = list(
  list(haupt = "soms2_64", folge = "soms2_65"),
  list(haupt = "soms2_66", folge = "soms2_67"),
  list(haupt = "soms2_68", folge = NULL)
)

# Spaltenzuordnung fuer die Prozentrang-Lookups je Normtabelle.
SOMS2_NORM_SPALTEN_A1 = list(
  dsmiv       = list(gesamt = "dsmiv_gesamt",            m = "dsmiv_m",            w = "dsmiv_w"),
  icd10       = list(gesamt = "icd10_gesamt",             m = "icd10_m",            w = "icd10_w"),
  sad         = list(gesamt = "sad_gesamt",               m = "sad_m",              w = "sad_w"),
  beschwerden = list(gesamt = "beschwerdenindex_gesamt",  m = "beschwerdenindex_m", w = "beschwerdenindex_w")
)
SOMS2_NORM_SPALTEN_A2 = list(
  dsmiv       = "dsmiv",
  icd10       = "icd10",
  sad         = "sad",
  beschwerden = "beschwerdenindex_gesamt"
)


# 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-zeile.item-unterpunkt { padding-left: 28px; border-bottom: none; }
.item-nr   { font-weight: 600; color: #8B2635; min-width: 34px; flex-shrink: 0; }
.item-text { flex: 1; color: #333; font-size: 0.92em; }
.kriterien-liste { margin: 10px 0; padding: 0; list-style: none; }
.kriterium-zeile {
  display: flex; align-items: flex-start; gap: 10px; padding: 8px 0;
  border-bottom: 1px solid #F5F5F5; font-size: 0.92em; color: #444;
}
.kriterium-status { font-weight: 700; min-width: 100px; flex-shrink: 0; }
.kriterium-erfuellt       { color: #2E7D32; }
.kriterium-nicht-erfuellt { color: #B71C1C; }
.kriterium-inhalt { flex: 1; display: flex; flex-direction: column; gap: 2px; }
.kriterium-frage  { color: #333; }
.kriterium-antwort { color: #777; font-size: 0.85em; }
.kriterium-verknuepfung {
  font-size: 0.78em; color: #999; font-style: italic; margin: 2px 0;
}
.gesamtstatus-box {
  border-radius: 6px; padding: 12px 16px; margin-top: 10px;
  font-weight: 700; border-left: 5px solid;
}
.gesamtstatus-erfuellt       { background: #E8F5E9; border-color: #2E7D32; color: #2E7D32; }
.gesamtstatus-nicht-erfuellt { background: #F5F5F5; border-color: #9E9E9E; color: #616161; }
.score-zahl  { font-size: 2.2rem; font-weight: 800; color: #8B2635; }
.score-label { color: #555; font-size: 0.9em; }
.pr-info { color: #555; font-size: 0.9em; margin-top: 4px; }
.cutoff-hinweis {
  background: #FFF3E0; border-left: 5px solid #E65100; color: #BF360C;
  padding: 10px 14px; border-radius: 4px; margin-top: 10px; font-size: 0.9em;
}
.normwahl-hinweis { color: #777; font-size: 0.82em; font-style: italic; margin-top: 6px; }
.start-hinweis { text-align: center; color: #bbb; padding: 30px 0; font-style: italic; }
"

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("SOMS-2 - Screening fuer somatoforme Stoerungen (2-Jahres-Version)"),
    tags$p("Rief, Hiller & Heuser 1997 | Vier parallele Auswertungskennwerte")
  ),

  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)")
      )
    ),

    div(class = "input-panel",
      div(
        tags$label("Vergleichsnorm",
                    style = "font-weight:600; color:#333; display:block; margin-bottom:4px;"),
        radioButtons("normwahl", label = NULL,
          choices = c("Gesunde" = "gesunde", "psychosomatische Patienten" = "patienten"),
          selected = "gesunde", inline = TRUE)
      ),
      uiOutput("normwahl_hinweis_ui")
    ),

    uiOutput("ergebnis_ui")
  )
)


# Word-Export ####

erstelle_soms2_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_erfuellt   = fp_text(font.size = 10, bold = TRUE, color = "#2E7D32")
  fp_nicht      = fp_text(font.size = 10, bold = TRUE, color = "#B71C1C")
  fp_gesamt_ok  = fp_text(font.size = 11, bold = TRUE, color = "#2E7D32")
  fp_gesamt_nok = fp_text(font.size = 11, bold = TRUE, color = "#616161")
  fp_cutoff     = fp_text(font.size = 10, italic = TRUE, color = "#BF360C")
  fp_warnung    = fp_text(font.size = 10, italic = TRUE, color = "#8a6d00")
  fp_normhinweis = fp_text(font.size = 9.5, italic = TRUE, color = "#555555")
  fp_antwort    = fp_text(font.size = 9.5, color = "#777777")
  fp_verknuepfung = fp_text(font.size = 9, italic = TRUE, color = "#999999")
  fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")

  doc = body_add_fpar(doc, fpar(ftext("SOMS-2 - Auswertung", fp_titel)))
  doc = body_add_fpar(doc, fpar(
    ftext("Chiffre: ",            fp_label),
    ftext(erg$chiffre,            fp_normal),
    ftext("     Ausfuelldatum: ", fp_label),
    ftext(erg$datum_str,          fp_normal),
    ftext("     Geschlecht: ",    fp_label),
    ftext(if (is.na(erg$geschlecht_text)) "k. A." else erg$geschlecht_text, fp_normal)
  ))
  if (!is.null(erg$warnung_daten)) {
    doc = body_add_fpar(doc, fpar(ftext(erg$warnung_daten, fp_warnung)))
  }
  doc = body_add_fpar(doc, fpar(ftext(
    if (identical(erg$normwahl, "patienten"))
      "Vergleichsnorm: psychosomatische Patienten (nicht nach Geschlecht getrennt)"
    else
      "Vergleichsnorm: Gesunde",
    fp_normhinweis
  )))
  doc = body_add_par(doc, "", style = "Normal")

  for (idx in erg$indizes) {
    doc = body_add_fpar(doc, fpar(ftext(idx$titel, fp_abschnitt)))
    doc = body_add_fpar(doc, fpar(
      ftext("Rohwert: ", fp_label),
      ftext(paste0(idx$rohwert, " / ", idx$max), fp_normal),
      ftext("     Prozentrang: ", fp_label),
      ftext(if (is.na(idx$pr)) "k. A." else paste0(idx$pr), fp_normal)
    ))
    if (!is.null(idx$kriterien)) {
      for (k in idx$kriterien) {
        status_txt = if (isTRUE(k$erfuellt)) "[erfuellt] " else "[nicht erfuellt] "
        status_fp  = if (isTRUE(k$erfuellt)) fp_erfuellt else fp_nicht
        for (i in seq_along(k$teile)) {
          teil = k$teile[[i]]
          if (i == 1) {
            doc = body_add_fpar(doc, fpar(ftext(status_txt, status_fp), ftext(teil$text, fp_normal)))
          } else {
            doc = body_add_fpar(doc, fpar(
              ftext(paste0("  ", k$verknuepfung, "  "), fp_verknuepfung),
              ftext(teil$text, fp_normal)
            ))
          }
          doc = body_add_fpar(doc, fpar(ftext(
            paste0("     Antwort: ", teil$antwort, "  (erforderlich: ", teil$erforderlich, ")"),
            fp_antwort
          )))
        }
      }
      doc = body_add_fpar(doc, fpar(ftext(
        if (isTRUE(idx$gesamtstatus)) "Kriterien fuer Verdachtsdiagnose erfuellt"
        else "Kriterien fuer Verdachtsdiagnose nicht (vollstaendig) erfuellt",
        if (isTRUE(idx$gesamtstatus)) fp_gesamt_ok else fp_gesamt_nok
      )))
    }
    if (!is.null(idx$cutoff_hinweis)) {
      doc = body_add_fpar(doc, fpar(ftext(idx$cutoff_hinweis, fp_cutoff)))
    }
    if (identical(idx$key, "beschwerden")) {
      if (length(erg$beschwerden_ja_items) > 0) {
        doc = body_add_fpar(doc, fpar(ftext("Angegebene Beschwerden (mit 'ja' beantwortet):", fp_label)))
        for (b in erg$beschwerden_ja_items) {
          doc = body_add_fpar(doc, fpar(ftext(paste0(b$nr, ". ", b$text), fp_normal)))
        }
      } else {
        doc = body_add_fpar(doc, fpar(ftext("Keine der 53 Beschwerden wurde mit 'ja' beantwortet.", fp_normal)))
      }
    }
    doc = body_add_par(doc, "", style = "Normal")
  }

  if (length(erg$screening_hinweise) > 0) {
    doc = body_add_fpar(doc, fpar(ftext("Weitere Screening-Hinweise", fp_abschnitt)))
    for (h in erg$screening_hinweise) {
      doc = body_add_fpar(doc, fpar(ftext(paste0(h$nr, ". ", h$text), fp_normal)))
      if (!is.null(h$folge_text)) {
        doc = body_add_fpar(doc, fpar(ftext(paste0("     -> ", h$folge_text), fp_normal)))
      }
    }
    doc = body_add_par(doc, "", style = "Normal")
  }

  doc = body_add_fpar(doc, fpar(ftext(SOMS2_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)))
    }
  })

  rohdaten_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: ", PFAD_DOWNLOAD_SKRIPT)))
    }
    if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) {
      return(list(typ = "skript_fehler",
        meldung = paste0("Pseudonym-Skript nicht gefunden: ", 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 = 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
    })
    if (is.null(db_ordner)) {
      return(list(typ = "skript_fehler",
        meldung = "pseudonyme.db wurde ausgehend vom Pseudonym-Skript-Ordner bis zu 5 Ebenen nach oben nicht gefunden."))
    }

    alter_wd = getwd()
    on.exit(setwd(alter_wd), add = TRUE)
    setwd(db_ordner)

    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_soms2", envir = .GlobalEnv)) {
      return(list(typ = "skript_fehler",
        meldung = "Objekt 'daten_soms2' wurde nach dem Sourcen des Download-Skripts nicht gefunden."))
    }
    if (!exists("pseudo", envir = .GlobalEnv)) {
      return(list(typ = "skript_fehler",
        meldung = "Objekt 'pseudo' wurde nach dem Sourcen des Pseudonym-Skripts nicht gefunden."))
    }

    daten_soms2 = get("daten_soms2", envir = .GlobalEnv)
    pseudo      = get("pseudo",      envir = .GlobalEnv)

    if (nchar(trimws(input$pseudonym)) > 0) {
      pw_treffer = pseudo[pseudo$pseudonym == trimws(input$pseudonym), ]
      if (nrow(pw_treffer) > 0) chiffre = toupper(trimws(pw_treffer$chiffre[1]))
    }

    treffer_ps = pseudo[pseudo$chiffre == chiffre, ]
    if (nrow(treffer_ps) == 0) {
      return(list(typ = "chiffre_nicht_gefunden", chiffre = chiffre))
    }

    alle_session_ids = unique(treffer_ps$pseudonym)
    if (nchar(trimws(input$pseudonym)) > 0) alle_session_ids = trimws(input$pseudonym)

    treffer_dat = daten_soms2[daten_soms2$session %in% alle_session_ids, ]
    if (nrow(treffer_dat) == 0) {
      return(list(typ = "session_nicht_gefunden", chiffre = chiffre))
    }

    warnung_daten = 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"
      )
      warnung_daten = 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")
    )

    geschlecht_text = soms2_geschlecht_text(daten_soms2[["soms2_geschlecht"]], zeile[["soms2_geschlecht"]])

    dsmiv_rohwert = soms2_score_items(zeile, daten_soms2, SOMS2_DSMIV_ITEMS)
    dsmiv_max     = soms2_dsmiv_max(geschlecht_text)
    dsmiv_krit    = soms2_dsmiv_kriterien(zeile, daten_soms2)

    icd10_rohwert = soms2_score_einheiten(zeile, daten_soms2, SOMS2_ICD10_EINHEITEN)
    icd10_max     = soms2_icd10_max(geschlecht_text)
    icd10_krit    = soms2_icd10_kriterien(zeile, daten_soms2)

    sad_rohwert = soms2_score_einheiten(zeile, daten_soms2, SOMS2_SAD_EINHEITEN)
    sad_max     = 12L
    sad_krit    = soms2_sad_kriterien(zeile, daten_soms2)

    beschwerden_rohwert = soms2_score_items(zeile, daten_soms2, SOMS2_BESCHWERDEN_ITEMS)
    beschwerden_max     = soms2_beschwerden_max(geschlecht_text)

    # Liste der einzelnen mit "ja" beantworteten Beschwerden (Items 1-53) fuer
    # die Anzeige unter dem Beschwerdenindex.
    beschwerden_ja_items = list()
    for (it in SOMS2_BESCHWERDEN_ITEMS) {
      if (isTRUE(soms2_ist_ja(daten_soms2[[it]], zeile[[it]]))) {
        beschwerden_ja_items[[length(beschwerden_ja_items) + 1]] = list(
          nr   = as.integer(sub("^soms2_", "", it)),
          text = soms2_item_text(daten_soms2, it)
        )
      }
    }

    screening_hinweise = list()
    for (paar in SOMS2_ZUSATZ_ITEMS) {
      if (isTRUE(soms2_ist_ja(daten_soms2[[paar$haupt]], zeile[[paar$haupt]]))) {
        folge_text = NULL
        if (!is.null(paar$folge) && isTRUE(soms2_ist_ja(daten_soms2[[paar$folge]], zeile[[paar$folge]]))) {
          folge_text = soms2_item_text(daten_soms2, paar$folge)
        }
        screening_hinweise[[length(screening_hinweise) + 1]] = list(
          nr         = as.integer(sub("^soms2_", "", paar$haupt)),
          text       = soms2_item_text(daten_soms2, paar$haupt),
          folge_text = folge_text
        )
      }
    }

    list(
      typ                 = "ergebnis",
      chiffre             = chiffre,
      datum_str           = datum_str,
      warnung_daten       = warnung_daten,
      geschlecht_text     = geschlecht_text,
      dsmiv_rohwert       = dsmiv_rohwert, dsmiv_max = dsmiv_max, dsmiv_krit = dsmiv_krit,
      icd10_rohwert       = icd10_rohwert, icd10_max = icd10_max, icd10_krit = icd10_krit,
      sad_rohwert         = sad_rohwert,   sad_max   = sad_max,   sad_krit   = sad_krit,
      beschwerden_rohwert = beschwerden_rohwert, beschwerden_max = beschwerden_max,
      beschwerden_ja_items = beschwerden_ja_items,
      screening_hinweise  = screening_hinweise
    )
  })

  # Leichtgewichtiges reactive() statt eventReactive: die Prozentraenge sollen
  # sich sofort aktualisieren, wenn die Vergleichsnorm umgeschaltet wird, ohne
  # dass erneut "Auswerten" geklickt werden muss (Rohdaten/Kriterien bleiben
  # dabei unveraendert, nur der Normtabellen-Lookup wird neu berechnet).
  ergebnis_r = reactive({
    d = rohdaten_r()
    if (d$typ != "ergebnis") return(d)

    normwahl = input$normwahl
    if (is.null(normwahl)) normwahl = "gesunde"

    dsmiv_pr = soms2_pr_ergebnis("dsmiv",       d$dsmiv_rohwert,       d$geschlecht_text, normwahl, soms2_norm_a1, soms2_norm_a2)
    icd10_pr = soms2_pr_ergebnis("icd10",       d$icd10_rohwert,       d$geschlecht_text, normwahl, soms2_norm_a1, soms2_norm_a2)
    sad_pr   = soms2_pr_ergebnis("sad",         d$sad_rohwert,         d$geschlecht_text, normwahl, soms2_norm_a1, soms2_norm_a2)
    besch_pr = soms2_pr_ergebnis("beschwerden", d$beschwerden_rohwert, d$geschlecht_text, normwahl, soms2_norm_a1, soms2_norm_a2)

    indizes = list(
      list(
        key = "dsmiv", titel = "Somatisierungsindex DSM-IV",
        rohwert = d$dsmiv_rohwert, max = d$dsmiv_max,
        pr = dsmiv_pr$pr, pr_gesamt = dsmiv_pr$pr_gesamt,
        kriterien = d$dsmiv_krit,
        gesamtstatus = all(vapply(d$dsmiv_krit, function(k) isTRUE(k$erfuellt), logical(1))),
        cutoff_hinweis = NULL
      ),
      list(
        key = "icd10", titel = "Somatisierungsindex ICD-10",
        rohwert = d$icd10_rohwert, max = d$icd10_max,
        pr = icd10_pr$pr, pr_gesamt = icd10_pr$pr_gesamt,
        kriterien = d$icd10_krit,
        gesamtstatus = all(vapply(d$icd10_krit, function(k) isTRUE(k$erfuellt), logical(1))),
        cutoff_hinweis = NULL
      ),
      list(
        key = "sad", titel = "SAD-Index ICD-10",
        rohwert = d$sad_rohwert, max = d$sad_max,
        pr = sad_pr$pr, pr_gesamt = sad_pr$pr_gesamt,
        kriterien = d$sad_krit,
        gesamtstatus = all(vapply(d$sad_krit, function(k) isTRUE(k$erfuellt), logical(1))),
        cutoff_hinweis = NULL
      ),
      list(
        key = "beschwerden", titel = "Beschwerdenindex Somatisierung",
        rohwert = d$beschwerden_rohwert, max = d$beschwerden_max,
        pr = besch_pr$pr, pr_gesamt = besch_pr$pr_gesamt,
        kriterien = NULL,
        gesamtstatus = NA,
        cutoff_hinweis = if (isTRUE(d$beschwerden_rohwert >= 7)) SOMS2_BESCHWERDEN_CUTOFF_HINWEIS else NULL
      )
    )

    c(d, list(normwahl = normwahl, indizes = indizes))
  })

  output$normwahl_hinweis_ui = renderUI({
    if (identical(input$normwahl, "patienten")) {
      div(class = "normwahl-hinweis",
        "Die Patientennorm liegt nicht nach Geschlecht getrennt vor (eine Vergleichsgruppe fuer alle).")
    } else {
      NULL
    }
  })

  output$ergebnis_ui = renderUI({

    if (input$btn_suchen == 0) {
      return(div(class = "abschnitt-karte start-hinweis",
        "Bitte Chiffre oder Pseudonym eingeben und auf 'Auswerten' klicken."
      ))
    }

    erg = ergebnis_r()

    if (erg$typ == "leere_eingabe") {
      return(div(class = "alert-warnung", erg$meldung))
    }
    if (erg$typ == "format_fehler") {
      return(div(class = "alert-warnung",
        paste0("Ungueltige Chiffre '", erg$chiffre, "'. Erwartet: ein Grossbuchstabe gefolgt von 6 Ziffern (z. B. P000123).")))
    }
    if (erg$typ == "skript_fehler") {
      return(div(class = "alert-fehler", tags$pre(style = "white-space:pre-wrap; margin:0;", erg$meldung)))
    }
    if (erg$typ == "chiffre_nicht_gefunden") {
      return(div(class = "alert-fehler",
        paste0("Chiffre '", erg$chiffre, "' wurde in der Pseudonym-Datenbank nicht gefunden.")))
    }
    if (erg$typ == "session_nicht_gefunden") {
      return(div(class = "alert-fehler",
        paste0("Kein SOMS-2-Datensatz fuer Chiffre '", erg$chiffre, "' gefunden.")))
    }

    meta_block = div(class = "meta-block",
      tags$strong("Chiffre: "), erg$chiffre, "   ",
      tags$strong("Ausfuelldatum: "), erg$datum_str, "   ",
      tags$strong("Geschlecht: "), if (is.na(erg$geschlecht_text)) "k. A." else erg$geschlecht_text
    )

    kopf_karte = div(class = "abschnitt-karte",
      meta_block,
      if (!is.null(erg$warnung_daten)) div(class = "alert-warnung", erg$warnung_daten) else NULL
    )

    index_karten = lapply(erg$indizes, function(idx) {

      pr_text   = if (is.na(idx$pr)) "k. A." else paste0(idx$pr)
      pr_zusatz = if (!identical(erg$normwahl, "patienten") &&
                      !is.na(erg$geschlecht_text) &&
                      !is.na(idx$pr_gesamt))
        paste0(" (Gesamtnorm: ", idx$pr_gesamt, ")") else ""

      kriterien_ui = if (!is.null(idx$kriterien)) {
        tagList(
          div(class = "kriterien-liste",
            lapply(idx$kriterien, function(k) {
              teile_ui = lapply(seq_along(k$teile), function(i) {
                teil = k$teile[[i]]
                tagList(
                  if (i > 1) div(class = "kriterium-verknuepfung", k$verknuepfung) else NULL,
                  div(class = "kriterium-frage", teil$text),
                  div(class = "kriterium-antwort",
                      paste0("Antwort: ", teil$antwort, "  (erforderlich: ", teil$erforderlich, ")"))
                )
              })
              div(class = "kriterium-zeile",
                span(class = paste0("kriterium-status ",
                       if (isTRUE(k$erfuellt)) "kriterium-erfuellt" else "kriterium-nicht-erfuellt"),
                     if (isTRUE(k$erfuellt)) "erfuellt" else "nicht erfuellt"),
                div(class = "kriterium-inhalt", teile_ui)
              )
            })
          ),
          div(class = paste0("gesamtstatus-box ",
                 if (isTRUE(idx$gesamtstatus)) "gesamtstatus-erfuellt" else "gesamtstatus-nicht-erfuellt"),
              if (isTRUE(idx$gesamtstatus)) "Kriterien fuer Verdachtsdiagnose erfuellt"
              else "Kriterien fuer Verdachtsdiagnose nicht (vollstaendig) erfuellt")
        )
      } else NULL

      cutoff_ui = if (!is.null(idx$cutoff_hinweis)) div(class = "cutoff-hinweis", idx$cutoff_hinweis) else NULL

      beschwerden_liste_ui = if (identical(idx$key, "beschwerden")) {
        if (length(erg$beschwerden_ja_items) > 0) {
          tagList(
            tags$h5("Angegebene Beschwerden (mit 'ja' beantwortet)",
                    style = "margin-top:14px; margin-bottom:6px; color:#555; font-size:0.95em;"),
            lapply(erg$beschwerden_ja_items, function(b) {
              div(class = "item-zeile",
                div(class = "item-nr", paste0(b$nr, ".")),
                div(class = "item-text", b$text)
              )
            })
          )
        } else {
          div(class = "normwahl-hinweis",
              "Keine der 53 Beschwerden wurde mit 'ja' beantwortet.")
        }
      } else NULL

      div(class = "abschnitt-karte",
        div(class = "abschnitt-titel", idx$titel),
        div(
          span(class = "score-zahl", idx$rohwert),
          span(class = "score-label", paste0(" / ", idx$max))
        ),
        div(class = "pr-info", paste0("Prozentrang: ", pr_text, pr_zusatz)),
        kriterien_ui,
        cutoff_ui,
        beschwerden_liste_ui
      )
    })

    hinweise_karte = if (length(erg$screening_hinweise) > 0) {
      div(class = "abschnitt-karte",
        div(class = "abschnitt-titel", "Weitere Screening-Hinweise"),
        lapply(erg$screening_hinweise, function(h) {
          tagList(
            div(class = "item-zeile",
              div(class = "item-nr", paste0(h$nr, ".")),
              div(class = "item-text", h$text)
            ),
            if (!is.null(h$folge_text))
              div(class = "item-zeile item-unterpunkt",
                div(class = "item-text", h$folge_text))
            else NULL
          )
        })
      )
    } else NULL

    tagList(kopf_karte, index_karten, hinweise_karte)
  })

  output$download_word = downloadHandler(
    filename = function() {
      erg = tryCatch(ergebnis_r(), error = function(e) NULL)
      if (is.null(erg) || erg$typ != "ergebnis") return("SOMS2_Export.docx")
      chiffre_esc      = gsub("[^A-Za-z0-9_-]", "_", erg$chiffre)
      ausfuelldatum_fn = tryCatch(
        format(as.Date(erg$datum_str, "%d.%m.%Y"), "%Y%m%d"),
        error = function(e) format(Sys.Date(), "%Y%m%d")
      )
      paste0("SOMS2_", chiffre_esc, "_", ausfuelldatum_fn, ".docx")
    },
    content = function(file) {
      erg = tryCatch(ergebnis_r(), error = function(e) NULL)
      if (is.null(erg) || erg$typ != "ergebnis") {
        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_soms2_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)