# Präambel ####

AKZENT_FARBE = "#8B2635"

PFAD_DOWNLOAD_SKRIPT  = "../API/get_data_scid5spq.R"
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"

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

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


# Datenaufbereitung ####

# Querverweis im Manual: Item 44 wird fuer Schizotype PS angezeigt, aber auch
# fuer den Cutoff der Schizoiden PS mitgezaehlt (nur_cutoff = TRUE).
pq_ps_mapping = tibble::tribble(
  ~item_nr, ~ps,                              ~kriterium,                                    ~nur_cutoff,
  1,  "Vermeidend-Selbstunsichere PS", "Kriterium 1",                                        FALSE,
  2,  "Vermeidend-Selbstunsichere PS", "Kriterium 2",                                        FALSE,
  3,  "Vermeidend-Selbstunsichere PS", "Kriterium 3",                                        FALSE,
  4,  "Vermeidend-Selbstunsichere PS", "Kriterium 4",                                        FALSE,
  5,  "Vermeidend-Selbstunsichere PS", "Kriterium 5",                                        FALSE,
  6,  "Vermeidend-Selbstunsichere PS", "Kriterium 6",                                        FALSE,
  7,  "Vermeidend-Selbstunsichere PS", "Kriterium 7",                                        FALSE,
  8,  "Dependente PS",                 "Kriterium 1",                                        FALSE,
  9,  "Dependente PS",                 "Kriterium 2",                                        FALSE,
  10, "Dependente PS",                 "Kriterium 3",                                        FALSE,
  11, "Dependente PS",                 "Kriterium 4",                                        FALSE,
  12, "Dependente PS",                 "Kriterium 5",                                        FALSE,
  13, "Dependente PS",                 "Kriterium 6",                                        FALSE,
  14, "Dependente PS",                 "Kriterium 7",                                        FALSE,
  15, "Dependente PS",                 "Kriterium 8",                                        FALSE,
  16, "Zwanghafte PS",                 "Kriterium 1",                                        FALSE,
  17, "Zwanghafte PS",                 "Kriterium 2",                                        FALSE,
  18, "Zwanghafte PS",                 "Kriterium 3",                                        FALSE,
  19, "Zwanghafte PS",                 "Kriterium 4",                                        FALSE,
  20, "Zwanghafte PS",                 "Kriterium 5",                                        FALSE,
  21, "Zwanghafte PS",                 "Kriterium 6",                                        FALSE,
  22, "Zwanghafte PS",                 "Kriterium 7",                                        FALSE,
  23, "Zwanghafte PS",                 "Kriterium 8",                                        FALSE,
  24, "Zwanghafte PS",                 "Kriterium 8",                                        FALSE,
  25, "Paranoide PS",                  "Kriterium A1",                                       FALSE,
  26, "Paranoide PS",                  "Kriterium A2",                                       FALSE,
  27, "Paranoide PS",                  "Kriterium A3",                                       FALSE,
  28, "Paranoide PS",                  "Kriterium A4",                                       FALSE,
  29, "Paranoide PS",                  "Kriterium A5",                                       FALSE,
  30, "Paranoide PS",                  "Kriterium A5",                                       FALSE,
  31, "Paranoide PS",                  "Kriterium A6",                                       FALSE,
  32, "Paranoide PS",                  "Kriterium A7",                                       FALSE,
  33, "Schizotype PS",                 "Kriterium A1",                                       FALSE,
  34, "Schizotype PS",                 "Kriterium A1",                                       FALSE,
  35, "Schizotype PS",                 "Kriterium A1",                                       FALSE,
  36, "Schizotype PS",                 "Kriterium A2",                                       FALSE,
  37, "Schizotype PS",                 "Kriterium A2",                                       FALSE,
  38, "Schizotype PS",                 "Kriterium A2",                                       FALSE,
  39, "Schizotype PS",                 "Kriterium A2",                                       FALSE,
  40, "Schizotype PS",                 "Kriterium A3",                                       FALSE,
  41, "Schizotype PS",                 "Kriterium A3",                                       FALSE,
  42, "Schizotype PS",                 "Kriterium A3",                                       FALSE,
  43, "Schizotype PS",                 "Kriterium A3",                                       FALSE,
  44, "Schizotype PS",                 "Kriterium A8",                                       FALSE,
  44, "Schizoide PS",                  "Kriterium A5",                                       TRUE,
  45, "Schizotype PS",                 "Kriterium A9",                                       FALSE,
  46, "Schizoide PS",                  "Kriterium A1",                                       FALSE,
  47, "Schizoide PS",                  "Kriterium A2",                                       FALSE,
  48, "Schizoide PS",                  "Kriterium A3",                                       FALSE,
  49, "Schizoide PS",                  "Kriterium A4",                                       FALSE,
  50, "Schizoide PS",                  "Kriterium A6",                                       FALSE,
  51, "Schizoide PS",                  "Kriterium A7",                                       FALSE,
  52, "Histrionische PS",              "Kriterium 1",                                        FALSE,
  53, "Histrionische PS",              "Kriterium 2",                                        FALSE,
  54, "Histrionische PS",              "Kriterium 2",                                        FALSE,
  55, "Histrionische PS",              "Kriterium 4",                                        FALSE,
  56, "Histrionische PS",              "Kriterium 6",                                        FALSE,
  57, "Histrionische PS",              "Kriterium 6",                                        FALSE,
  58, "Histrionische PS",              "Kriterium 7",                                        FALSE,
  59, "Histrionische PS",              "Kriterium 8",                                        FALSE,
  60, "Narzisstische PS",              "Kriterium 1",                                        FALSE,
  61, "Narzisstische PS",              "Kriterium 1",                                        FALSE,
  62, "Narzisstische PS",              "Kriterium 2",                                        FALSE,
  63, "Narzisstische PS",              "Kriterium 2",                                        FALSE,
  64, "Narzisstische PS",              "Kriterium 3",                                        FALSE,
  65, "Narzisstische PS",              "Kriterium 3",                                        FALSE,
  66, "Narzisstische PS",              "Kriterium 4",                                        FALSE,
  67, "Narzisstische PS",              "Kriterium 5",                                        FALSE,
  68, "Narzisstische PS",              "Kriterium 6",                                        FALSE,
  69, "Narzisstische PS",              "Kriterium 6",                                        FALSE,
  70, "Narzisstische PS",              "Kriterium 7",                                        FALSE,
  71, "Narzisstische PS",              "Kriterium 7",                                        FALSE,
  72, "Narzisstische PS",              "Kriterium 7",                                        FALSE,
  73, "Narzisstische PS",              "Kriterium 8",                                        FALSE,
  74, "Narzisstische PS",              "Kriterium 8",                                        FALSE,
  75, "Narzisstische PS",              "Kriterium 9",                                        FALSE,
  76, "Narzisstische PS",              "Kriterium 9",                                        FALSE,
  77, "Borderline-PS",                 "Kriterium 1",                                        FALSE,
  78, "Borderline-PS",                 "Kriterium 2",                                        FALSE,
  79, "Borderline-PS",                 "Kriterium 3",                                        FALSE,
  80, "Borderline-PS",                 "Kriterium 3",                                        FALSE,
  81, "Borderline-PS",                 "Kriterium 3",                                        FALSE,
  82, "Borderline-PS",                 "Kriterium 3",                                        FALSE,
  83, "Borderline-PS",                 "Kriterium 4",                                        FALSE,
  84, "Borderline-PS",                 "Kriterium 5",                                        FALSE,
  85, "Borderline-PS",                 "Kriterium 5",                                        FALSE,
  86, "Borderline-PS",                 "Kriterium 6",                                        FALSE,
  87, "Borderline-PS",                 "Kriterium 7",                                        FALSE,
  88, "Borderline-PS",                 "Kriterium 8",                                        FALSE,
  89, "Borderline-PS",                 "Kriterium 8",                                        FALSE,
  90, "Borderline-PS",                 "Kriterium 8",                                        FALSE,
  91, "Borderline-PS",                 "Kriterium 9",                                        FALSE,
  92,  "Antisoziale PS",               "Verhalten vor dem 15. Lebensjahr, Kriterium 1",     FALSE,
  93,  "Antisoziale PS",               "Verhalten vor dem 15. Lebensjahr, Kriterium 2",     FALSE,
  94,  "Antisoziale PS",               "Verhalten vor dem 15. Lebensjahr, Kriterium 3",     FALSE,
  95,  "Antisoziale PS",               "Verhalten vor dem 15. Lebensjahr, Kriterium 4",     FALSE,
  96,  "Antisoziale PS",               "Verhalten vor dem 15. Lebensjahr, Kriterium 5",     FALSE,
  97,  "Antisoziale PS",               "Verhalten vor dem 15. Lebensjahr, Kriterium 6",     FALSE,
  98,  "Antisoziale PS",               "Verhalten vor dem 15. Lebensjahr, Kriterium 7",     FALSE,
  99,  "Antisoziale PS",               "Verhalten vor dem 15. Lebensjahr, Kriterium 8",     FALSE,
  100, "Antisoziale PS",               "Verhalten vor dem 15. Lebensjahr, Kriterium 9",     FALSE,
  101, "Antisoziale PS",               "Verhalten vor dem 15. Lebensjahr, Kriterium 10",    FALSE,
  102, "Antisoziale PS",               "Verhalten vor dem 15. Lebensjahr, Kriterium 11",    FALSE,
  103, "Antisoziale PS",               "Verhalten vor dem 15. Lebensjahr, Kriterium 12",    FALSE,
  104, "Antisoziale PS",               "Verhalten vor dem 15. Lebensjahr, Kriterium 13",    FALSE,
  105, "Antisoziale PS",               "Verhalten vor dem 13. Lebensjahr, Kriterium 14",    FALSE,
  106, "Antisoziale PS",               "Verhalten vor dem 13. Lebensjahr, Kriterium 15",    FALSE
)

PS_REIHENFOLGE = c(
  "Vermeidend-Selbstunsichere PS", "Dependente PS", "Zwanghafte PS",
  "Paranoide PS", "Schizotype PS", "Schizoide PS",
  "Histrionische PS", "Narzisstische PS", "Borderline-PS", "Antisoziale PS"
)

# beobachtungsbasiert_ohne_item: Kriterien die rein im Interview durch Beobachtung
# erhoben werden (kein SPQ-Item); zaehlen trotzdem zur Cutoff-Obergrenze, weil
# sie unabhaengig vom Screening mit "2" kodiert werden koennen.
ps_cutoffs = tibble::tribble(
  ~ps,                              ~kriterien_gesamt, ~cutoff, ~beobachtungsbasiert_ohne_item,
  "Vermeidend-Selbstunsichere PS",  7, 4, 0,
  "Dependente PS",                  8, 5, 0,
  "Zwanghafte PS",                  8, 4, 0,
  "Paranoide PS",                   7, 4, 0,
  "Schizotype PS",                  9, 5, 4,
  "Schizoide PS",                   7, 4, 0,
  "Histrionische PS",               8, 5, 2,
  "Narzisstische PS",               9, 5, 0,
  "Borderline-PS",                  9, 5, 0
)


# Helper ####

loeseLabel = function(rohwert, spalte) {
  labs = attr(spalte, "labels")
  if (is.null(labs) || is.na(rohwert)) return(NA_character_)
  treffer = names(labs)[labs == rohwert]
  if (length(treffer) == 0) return(NA_character_)
  treffer[1]
}

extrahiereNummer = function(label_text) {
  m = regmatches(label_text, regexpr("^(\\d+)\\.", label_text))
  if (length(m) == 0 || m == "") return(NA_integer_)
  as.integer(sub("\\.", "", m))
}

entferneNummernpraefix = function(label_text) {
  sub("^\\d+\\.\\s*", "", label_text)
}

berechneCutoffHinweis = function(ps_name, ja_item_nrs) {

  # Antisoziale PS hat Sonderlogik: Screening deckt nur Sozialverhalten-Kriterien ab,
  # adulte Kriterien werden unabhaengig im Interview erhoben.
  if (ps_name == "Antisoziale PS") {
    soz_ja = sum(
      pq_ps_mapping$ps == "Antisoziale PS" &
      pq_ps_mapping$item_nr %in% ja_item_nrs
    )
    if (soz_ja < 2) {
      return(list(
        erreichbar = FALSE,
        hinweis    = paste0(
          "(Sozialverhalten-Teilkriterium [2 von 15] anhand Screening nicht erreicht; ",
          "Gesamtdiagnose dadurch nicht ausgeschlossen, da die adulten Kriterien ",
          "unabhaengig vom Screening im Interview erhoben werden)"
        )
      ))
    }
    return(list(erreichbar = TRUE, hinweis = NULL))
  }

  ci = ps_cutoffs[ps_cutoffs$ps == ps_name, ]
  if (nrow(ci) == 0) return(list(erreichbar = TRUE, hinweis = NULL))

  cutoff = ci$cutoff
  beobs  = ci$beobachtungsbasiert_ohne_item

  ps_rows   = pq_ps_mapping[pq_ps_mapping$ps == ps_name, ]
  kriterien = unique(ps_rows$kriterium)
  hat_ja    = vapply(kriterien, function(k) {
    any(ps_rows$item_nr[ps_rows$kriterium == k] %in% ja_item_nrs)
  }, logical(1))
  kriterien_erfuellt = kriterien[hat_ja]
  kriterien_mit_ja   = length(kriterien_erfuellt)

  max_erreichbar = kriterien_mit_ja + beobs

  if (max_erreichbar >= cutoff) return(list(erreichbar = TRUE, hinweis = NULL))

  # Paranoide/Schizotype/Schizoide PS haben Ausschluss-Kriterium B das separat geprueft werden muss
  kb = if (ps_name %in% c("Paranoide PS", "Schizotype PS", "Schizoide PS")) {
    "; zusaetzlich ist Kriterium B [Ausschluss anderer Stoerungen] separat zu pruefen"
  } else ""

  erfuellt_text = if (length(kriterien_erfuellt) > 0)
    paste0(" [im Screening erfuellt: ", paste(kriterien_erfuellt, collapse = ", "), "]")
  else ""

  list(
    erreichbar = FALSE,
    hinweis    = paste0(
      "(Cutoff anhand Screening-Antworten nicht erreichbar: max. ", max_erreichbar,
      " von ", cutoff, " erforderlichen Kriterien moeglich", erfuellt_text, kb, ")"
    )
  )
}

# PS-Abschnitte mit JA-Items oder nicht-erreichbarem Cutoff werden angezeigt,
# PS ohne JA-Items UND erreichbarem Cutoff werden weggelassen.
gruppiereNachPS = function(tabelle, ja_item_nrs) {

  mapping_anzeige = pq_ps_mapping[!pq_ps_mapping$nur_cutoff, c("item_nr", "ps", "kriterium")]

  gruppen = lapply(PS_REIHENFOLGE, function(ps_name) {

    items_ps = mapping_anzeige[mapping_anzeige$ps == ps_name, c("item_nr", "kriterium")]
    if (!is.null(tabelle) && nrow(tabelle) > 0) {
      items_ja = merge(tabelle, items_ps, by.x = "Nummer", by.y = "item_nr")
      items_ja = items_ja[order(items_ja$Nummer), c("Nummer", "Frage", "kriterium")]
    } else {
      items_ja = data.frame(Nummer = integer(0), Frage = character(0),
                            kriterium = character(0), stringsAsFactors = FALSE)
    }

    cutoff_r = berechneCutoffHinweis(ps_name, ja_item_nrs)
    hat_ja   = nrow(items_ja) > 0

    if (!hat_ja && cutoff_r$erreichbar) return(NULL)

    list(
      ps             = ps_name,
      items          = items_ja,
      cutoff_erreich = cutoff_r$erreichbar,
      hinweis        = cutoff_r$hinweis
    )
  })

  Filter(Negate(is.null), gruppen)
}


# UI ####

app_css = "
  body {
    font-family: 'Segoe UI', Helvetica, Arial, sans-serif;
    background-color: #f4f4f4;
    color: #222;
    font-size: 14px;
  }

  .app-header {
    background-color: #8B2635;
    color: white;
    padding: 15px 22px 13px;
    margin-bottom: 18px;
    border-radius: 5px;
  }
  .app-header h2 { margin: 0; font-size: 1.4em; font-weight: 700; }
  .app-header p  { margin: 4px 0 0; font-size: 0.87em; opacity: 0.88; }

  .input-panel {
    display: flex;
    align-items: flex-end;
    gap: 10px;
    background: white;
    border-radius: 6px;
    padding: 14px 18px;
    margin-bottom: 16px;
    box-shadow: 0 1px 4px rgba(0,0,0,0.09);
    flex-wrap: wrap;
  }
  .input-panel .form-group { margin-bottom: 0; }

  .btn-laden {
    background-color: #8B2635 !important;
    border-color: #7A2030 !important;
    color: white !important;
    font-weight: 600;
    padding: 6px 18px;
    border-radius: 4px;
    letter-spacing: 0.02em;
    white-space: nowrap;
  }
  .btn-laden:hover, .btn-laden:focus {
    background-color: #6E1E29 !important;
    border-color: #6E1E29 !important;
    outline: none;
    box-shadow: 0 0 0 2px rgba(139,38,53,0.3) !important;
  }

  .abschnitt-karte {
    background: white;
    border-radius: 6px;
    padding: 16px 20px;
    margin-bottom: 14px;
    box-shadow: 0 1px 4px rgba(0,0,0,0.09);
  }
  .abschnitt-titel {
    color: #8B2635;
    margin-top: 0;
    margin-bottom: 12px;
    font-size: 1em;
    font-weight: 700;
    letter-spacing: 0.01em;
  }

  .alert-warnung {
    background-color: #FFFDE7;
    border-left: 4px solid #F9A825;
    border-radius: 3px;
    padding: 9px 12px;
    margin-bottom: 10px;
    font-size: 0.88em;
    color: #555;
    line-height: 1.45;
  }

  .alert-fehler {
    background-color: #FEECEB;
    border-left: 4px solid #C62828;
    border-radius: 4px;
    padding: 13px 16px;
    margin-bottom: 12px;
  }
  .alert-fehler h4 { color: #C62828; margin-top: 0; margin-bottom: 8px; }
  .alert-fehler p, .alert-fehler li { color: #444; font-size: 0.92em; }

  .ergebnis-kopf {
    color: #8B2635;
    margin: 8px 0 0 0;
    font-size: 1.05em;
    font-weight: 700;
  }

  .ps-abschnitt { margin-bottom: 18px; }
  .ps-titel {
    color: #8B2635;
    border-bottom: 1px solid #8B2635;
    padding-bottom: 3px;
    margin-top: 18px;
    margin-bottom: 4px;
    font-size: 1em;
    font-weight: 700;
  }

  p.cutoff-hinweis {
    color: #666;
    font-style: italic;
    font-weight: bold;
    font-size: 0.88em;
    margin: 2px 0 6px 0;
  }

  .item-zeile     { display: flex; margin-bottom: 4px; line-height: 1.45; }
  .item-nr        { min-width: 40px; font-weight: bold; color: #555; flex-shrink: 0; }
  .item-text      { flex: 1; }
  .item-kriterium { min-width: 130px; color: #777; font-size: 0.88em;
                    flex-shrink: 0; padding-left: 14px; align-self: center; }

  .start-hinweis {
    text-align: center;
    color: #bbb;
    padding: 40px 0;
    font-size: 0.95em;
  }
"

app_css = gsub("#8B2635", AKZENT_FARBE, app_css, fixed = TRUE)

ui = fluidPage(
  tags$head(tags$style(HTML(app_css))),

  div(class = "app-header",
    tags$h2("SCID-5-SPQ Item-Lookup"),
    tags$p("JA-Antworten im Screening nach Chiffre abrufen")
  ),

  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", "Suchen", class = "btn btn-primary btn-laden"),
    div(style = "margin-left: auto;",
      downloadButton("download_word", "Word-Export (.docx)")
    )
  ),

  uiOutput("ergebnis_ui")
)


# Word-Export ####

erstelle_scid5spq_docx = function(erg) {

  gruppen = gruppiereNachPS(erg$tabelle, erg$ja_item_nrs)

  fmt_titel      = fp_text(color = AKZENT_FARBE, bold = TRUE,  font.size = 18)
  fmt_meta       = fp_text(color = "#333333",    bold = FALSE,  font.size = 11)
  fmt_zusammenf  = fp_text(color = "#000000",    bold = TRUE,   font.size = 11)
  fmt_ps         = fp_text(color = AKZENT_FARBE, bold = TRUE,   font.size = 13)
  fmt_hinweis    = fp_text(color = "#666666",    italic = TRUE, font.size = 9.5)
  fmt_item_nr    = fp_text(color = "#555555",    bold = TRUE,   font.size = 10)
  fmt_item_text  = fp_text(color = "#000000",    bold = FALSE,  font.size = 10)
  fmt_item_krit  = fp_text(color = "#777777",    italic = TRUE, font.size = 9)
  fmt_disclaimer = fp_text(color = "#888888",    italic = TRUE, font.size = 9)

  doc = read_docx()

  doc = body_add_fpar(doc,
    fpar(ftext("SCID-5-SPQ - JA-Antworten im Screening", fmt_titel)))

  doc = body_add_fpar(doc, fpar(ftext(
    paste0("Chiffre: ", erg$chiffre,
           "     Ausfuelldatum: ", erg$ausfuelldatum,
           "     Erstellt am: ", format(Sys.Date(), "%d.%m.%Y")),
    fmt_meta)))

  if (!is.null(erg$warnung_daten))
    doc = body_add_fpar(doc, fpar(ftext(
      paste0("Hinweis: ", erg$warnung_daten),
      fp_text(color = "#B8860B", italic = TRUE, font.size = 9)
    )))

  doc = body_add_par(doc, "")

  doc = body_add_fpar(doc, fpar(ftext(
    paste0(erg$anzahl_ja, " von 106 Items mit JA beantwortet"), fmt_zusammenf)))

  for (g in gruppen) {
    doc = body_add_par(doc, "")
    doc = body_add_fpar(doc, fpar(ftext(g$ps, fmt_ps)))

    if (!is.null(g$hinweis)) {
      doc = body_add_fpar(doc, fpar(ftext(g$hinweis, fmt_hinweis)))
    }

    if (nrow(g$items) > 0) {
      for (i in seq_len(nrow(g$items))) {
        item = g$items[i, ]
        doc  = body_add_fpar(doc, fpar(
          ftext(paste0(item$Nummer, ".  "), fmt_item_nr),
          ftext(item$Frage,                 fmt_item_text),
          ftext(paste0("  ", item$kriterium), fmt_item_krit)
        ))
      }
    }
  }

  doc = body_add_par(doc, "")
  doc = body_add_fpar(doc, fpar(ftext(SCID5SPQ_DISCLAIMER, fmt_disclaimer)))

  doc
}


# Server ####

server = function(input, output, session) {
  # --- pseudonym-support-injection v1 ---
  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)))
    }
  })

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

    if (!(nchar(trimws(input$pseudonym)) > 0 || grepl("^[A-Z][0-9]{6}$", chiffre))) {
      return(list(typ = "format_fehler", chiffre = chiffre))
    }

    pfadfehler = character(0)
    if (!file.exists(PFAD_DOWNLOAD_SKRIPT))
      pfadfehler = c(pfadfehler,
        paste0("Download-Skript nicht gefunden: >>", PFAD_DOWNLOAD_SKRIPT, "<<"))
    if (!file.exists(PFAD_PSEUDONYM_SKRIPT))
      pfadfehler = c(pfadfehler,
        paste0("Pseudonym-Skript nicht gefunden: >>", PFAD_PSEUDONYM_SKRIPT, "<<"))
    if (length(pfadfehler) > 0) {
      return(list(typ = "skript_fehler",
        meldung = paste("Bitte Pfade am Kopf der app.R anpassen:",
                        paste(pfadfehler, collapse = "\n"), sep = "\n")))
    }

    ok_dl = tryCatch({
      source(PFAD_DOWNLOAD_SKRIPT, local = FALSE); TRUE
    }, error = function(e) {
      list(typ = "skript_fehler",
        meldung = paste0("Fehler im Download-Skript (",
                         basename(PFAD_DOWNLOAD_SKRIPT), "):\n", e$message))
    })
    if (is.list(ok_dl)) return(ok_dl)

    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 = paste0(
          "pseudonyme.db nicht gefunden.\n",
          "Gesucht ausgehend vom Pseudonym-Skript-Ordner bis zu 5 Ebenen nach oben.\n",
          "Bitte sicherstellen, dass pseudonyme.db im selben oder einem ",
          "uebergeordneten Ordner liegt."
        )))
    }

    ok_ps = tryCatch({
      alter_wd = getwd()
      on.exit(setwd(alter_wd), add = TRUE)
      setwd(db_ordner)
      source(PFAD_PSEUDONYM_SKRIPT, local = FALSE)
      if (nchar(trimws(input$pseudonym)) > 0) {
        .pw_wert = trimws(input$pseudonym)
        .pw_tab = get("pseudo", envir = .GlobalEnv)
        .pw_treffer = .pw_tab[.pw_tab$pseudonym == .pw_wert, ]
        if (nrow(.pw_treffer) > 0) chiffre = toupper(trimws(.pw_treffer$chiffre[1]))
      }; TRUE
    }, error = function(e) {
      list(typ = "skript_fehler",
        meldung = paste0("Fehler im Pseudonym-Skript (",
                         basename(PFAD_PSEUDONYM_SKRIPT), "):\n", e$message))
    })
    if (is.list(ok_ps)) return(ok_ps)

    if (!exists("daten_scid5spq", envir = .GlobalEnv)) {
      return(list(typ = "skript_fehler",
        meldung = paste0("Objekt 'daten_scid5spq' fehlt nach dem Sourcen von:\n",
                         PFAD_DOWNLOAD_SKRIPT)))
    }
    if (!exists("pseudo", envir = .GlobalEnv)) {
      return(list(typ = "skript_fehler",
        meldung = paste0("Objekt 'pseudo' fehlt nach dem Sourcen von:\n",
                         PFAD_PSEUDONYM_SKRIPT)))
    }

    daten_spq = get("daten_scid5spq", envir = .GlobalEnv)
    pseudo_df = get("pseudo",         envir = .GlobalEnv)

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

    alle_session_ids = unique(as.character(treffer_pseudo$pseudonym))
    if (nchar(trimws(input$pseudonym)) > 0) alle_session_ids = trimws(input$pseudonym)

    treffer_daten = daten_spq[daten_spq$session %in% alle_session_ids, ]
    if (nrow(treffer_daten) == 0) {
      return(list(typ = "session_nicht_gefunden",
                  chiffre    = chiffre,
                  session_id = paste(alle_session_ids, collapse = ", ")))
    }

    warnung_daten = NULL
    if (nrow(treffer_daten) > 1) {
      zeitstempel   = format(sort(treffer_daten$created, decreasing = TRUE),
                             "%d.%m.%Y %H:%M")
      warnung_daten = paste0(
        nrow(treffer_daten), " Einreichungen gefunden (Zeitstempel: ",
        paste(zeitstempel, collapse = ", "), "). Es wird die aktuellste verwendet.")
      treffer_daten = treffer_daten[order(treffer_daten$created, decreasing = TRUE), ]
      treffer_daten = treffer_daten[1, ]
    }

    zeile         = treffer_daten[1, ]
    ausfuelldatum = format(as.POSIXct(zeile$created), "%d.%m.%Y", tz = "Europe/Berlin")

    item_spalten = paste0("q", sprintf("%03d", 1:106))
    ja_items     = list()

    for (spname in item_spalten) {
      if (!spname %in% names(zeile)) next
      spalte  = daten_spq[[spname]]
      rohwert = zeile[[spname]]
      if (is.na(rohwert)) next
      antwort = loeseLabel(rohwert, spalte)
      if (is.na(antwort) || toupper(trimws(antwort)) != "JA") next
      label_text  = attr(spalte, "label")
      item_nummer = extrahiereNummer(label_text)
      fragetext   = entferneNummernpraefix(label_text)
      ja_items[[length(ja_items) + 1]] = data.frame(
        Nummer = item_nummer, Frage = fragetext, stringsAsFactors = FALSE)
    }

    if (length(ja_items) > 0) {
      tabelle = do.call(rbind, ja_items)
      tabelle = tabelle[order(tabelle$Nummer), ]
    } else {
      tabelle = NULL
    }

    list(
      typ           = "ergebnis",
      chiffre       = chiffre,
      ausfuelldatum = ausfuelldatum,
      tabelle       = tabelle,
      ja_item_nrs   = if (!is.null(tabelle)) tabelle$Nummer else integer(0),
      anzahl_ja     = length(ja_items),
      warnung_daten = warnung_daten
    )
  })


  output$ergebnis_ui = renderUI({

    if (input$btn_suchen == 0) {
      return(div(class = "start-hinweis",
        "Patientenchiffre eingeben und auf \"Suchen\" klicken."
      ))
    }

    erg = ergebnis_r()

    if (erg$typ == "skript_fehler") {
      return(div(class = "alert-fehler",
        tags$h4("Konfigurationsfehler"),
        tags$pre(style = "font-size:0.88em; white-space:pre-wrap;", erg$meldung)
      ))
    }

    if (erg$typ == "leere_eingabe") {
      return(div(class = "alert-warnung",
        "Bitte eine Patientenchiffre eingeben."
      ))
    }

    if (erg$typ == "format_fehler") {
      return(div(class = "alert-warnung",
        "Ungültige Chiffre. Erwartet wird ein Großbuchstabe gefolgt von 6 Ziffern, z.B. P000123."
      ))
    }

    if (erg$typ == "chiffre_nicht_gefunden") {
      return(div(class = "alert-fehler",
        tags$h4("Chiffre nicht gefunden"),
        tags$p("Die Chiffre ", tags$b(paste0("«", erg$chiffre, "»")),
               " ist in der Pseudonymtabelle nicht vorhanden."),
        tags$p("Bitte Schreibweise prüfen oder Pseudonymtabelle aktualisieren.")
      ))
    }

    if (erg$typ == "session_nicht_gefunden") {
      return(div(class = "alert-fehler",
        tags$h4("Keine Daten gefunden"),
        tags$p("Zur Chiffre ", tags$b(paste0("«", erg$chiffre, "»")),
               " existiert ein Pseudonymeintrag, aber kein Datensatz in ",
               tags$code("daten_scid5spq"), "."),
        tags$p("Mögliche Ursachen: Bogen noch nicht ausgefüllt, ",
               "oder Daten noch nicht heruntergeladen.")
      ))
    }

    gruppen = gruppiereNachPS(erg$tabelle, erg$ja_item_nrs)

    kopf_block = div(class = "abschnitt-karte",
      div(style = "border-bottom: 1px solid #eee; padding-bottom: 10px; margin-bottom: 8px;",
        tags$b("Chiffre: "), erg$chiffre, "  ",
        tags$b("Ausfülldatum: "), erg$ausfuelldatum
      ),
      if (!is.null(erg$warnung_daten))
        div(class = "alert-warnung", "⚠ Hinweis: ", erg$warnung_daten),
      tags$p(class = "ergebnis-kopf",
        paste0(erg$anzahl_ja, " von 106 Items mit JA beantwortet"))
    )

    if (erg$anzahl_ja == 0 && length(gruppen) == 0) {
      return(tagList(
        kopf_block,
        div(class = "abschnitt-karte",
          tags$p(style = "color:#555; font-style:italic;",
            "Keine der 106 Fragen wurde mit JA beantwortet. ",
            "Hinweise zu Cutoffs weiter unten beachten, sofern vorhanden.")
        )
      ))
    }

    gruppen_ui = tagList(lapply(gruppen, function(g) {
      div(class = "ps-abschnitt",
        tags$h4(class = "ps-titel", g$ps),
        if (!is.null(g$hinweis))
          tags$p(class = "cutoff-hinweis", g$hinweis)
        else NULL,
        if (nrow(g$items) > 0) {
          tagList(lapply(seq_len(nrow(g$items)), function(i) {
            item = g$items[i, ]
            div(class = "item-zeile",
              tags$span(class = "item-nr",        paste0(item$Nummer, ".")),
              tags$span(class = "item-text",      item$Frage),
              tags$span(class = "item-kriterium", item$kriterium))
          }))
        } else NULL
      )
    }))

    tagList(kopf_block, gruppen_ui)
  })


  output$download_word = downloadHandler(
    filename = function() {
      erg = ergebnis_r()
      if (is.null(erg) || erg$typ != "ergebnis") return("SCID5SPQ_Auswertung.docx")
      chiffre_esc      = gsub("[^A-Za-z0-9_-]", "_", erg$chiffre)
      ausfuelldatum_fn = format(as.Date(erg$ausfuelldatum, "%d.%m.%Y"), "%Y%m%d")
      paste0("SCID5SPQ_", chiffre_esc, "_", ausfuelldatum_fn, ".docx")
    },
    content = function(file) {
      req(ergebnis_r()$typ == "ergebnis")
      erg = ergebnis_r()
      doc = erstelle_scid5spq_docx(erg)
      print(doc, target = file)
    }
  )
}


# Start ####

shinyApp(ui = ui, server = server)