# Praeambel #### PFAD_DOWNLOAD_SKRIPT = "../API/get_data_iesr.R" # liefert: daten_iesr PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R" # liefert: pseudo AKZENT_FARBE = "#8B2635" IESR_DISCLAIMER = paste0( "Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ", "keine klinische Diagnostik. Die hier berechnete Verdachtsdiagnose beruht auf einer ", "statistischen Formel (Maercker und Schuetzwohl, 1998) und ist kein automatisiertes ", "klinisches Urteil. Die Interpretation obliegt der behandelnden Person." ) # Verlauf gruen -> dunkelrot entspricht den 4 Antwortstufen 0-3 (Rohwert, # nicht Punktwert, da die Punktwerte 0/1/3/5 selbst nicht gleichmaessig gestuft sind). IESR_BADGE_FARBEN = c( "0" = "#4CAF50", "1" = "#F48FB1", "2" = "#EF5350", "3" = "#B71C1C" ) IESR_BADGE_TEXT_FARBEN = c( "0" = "white", "1" = "#333333", "2" = "white", "3" = "white" ) IESR_ANTWORT_TEXTE = c("ueberhaupt nicht", "selten", "manchmal", "oft") IESR_KLASSIFIKATION_WORD_FARBEN = list( ja = list(bg = "#FFEBEE", text = "#B71C1C"), nein = list(bg = "#E8F5E9", text = "#2E7D32") ) library(shiny) library(dplyr) library(ggplot2) library(haven) library(officer) # Infrastruktur #### APP_VERZEICHNIS = normalizePath(getwd()) absPath = function(pfad) { if (grepl("^([A-Za-z]:[/\\\\]|/)", pfad)) return(pfad) file.path(APP_VERZEICHNIS, pfad) } PFAD_DOWNLOAD_SKRIPT = normalizePath(absPath(PFAD_DOWNLOAD_SKRIPT), mustWork = FALSE) PFAD_PSEUDONYM_SKRIPT = normalizePath(absPath(PFAD_PSEUDONYM_SKRIPT), mustWork = FALSE) # Helper #### IESR_SUBSKALEN = list( Intrusion = c(1, 3, 6, 9, 14, 16, 20), Vermeidung = c(5, 7, 8, 11, 12, 13, 17, 22), Uebererregung = c(2, 4, 10, 15, 18, 19, 21) ) IESR_SUBSKALEN_MAX = c(Intrusion = 35, Vermeidung = 40, Uebererregung = 35) IESR_GESAMT_MAX = 110 # Rohwert (Choice-Index - 1) -> Punktwert. NICHT linear (Manual-Tabelle), # daher als Lookup und nicht als arithmetische Formel implementiert. IESR_PUNKTE_LOOKUP = c("0" = 0, "1" = 1, "2" = 3, "3" = 5) # labels-Attribut der ORIGINAL-Spalte (vor Subsetting) lesen, damit die # Zuordnung Wert -> Rohwert (0-3) immer aus den Daten selbst stammt und # nicht hartkodiert wird. iesr_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 } iesr_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)) IESR_ANTWORT_TEXTE[stufe + 1L] } # Entfernt formr-Nummerierungsartefakte am Anfang des Itemtexts # (z.B. "1. ", "01) " oder nur noch ". " als Rest einer vorgelagerten # Nummerierung). Strippt jede fuehrende Folge von Nicht-Buchstaben bis # zum ersten echten Wortzeichen, statt ein einzelnes Format anzunehmen. clean_item_label = function(text) { if (is.null(text) || length(text) == 0 || is.na(text[1])) return(NA_character_) txt = trimws(as.character(text[1])) txt = sub("^[^\\p{L}]+", "", txt, perl = TRUE) trimws(txt) } make_gauge_iesr = function(wert, max_wert, titel) { wert_kl = max(0, min(wert, max_wert)) ggplot() + geom_rect(aes(xmin = 0, xmax = max_wert, ymin = 0, ymax = 1), fill = "#F0F0F0", color = "#9E9E9E", linewidth = 0.6) + geom_rect(aes(xmin = 0, xmax = wert_kl, ymin = 0, ymax = 1), fill = AKZENT_FARBE, color = NA) + geom_segment(aes(x = wert_kl, xend = wert_kl, y = -0.3, yend = 1.3), color = AKZENT_FARBE, linewidth = 1.3) + annotate("text", x = 0, y = -0.7, label = "0", hjust = 0, size = 3.2, color = "#555555") + annotate("text", x = max_wert, y = -0.7, label = as.character(max_wert), hjust = 1, size = 3.2, color = "#555555") + scale_x_continuous(limits = c(0, max_wert)) + scale_y_continuous(limits = c(-1.0, 1.6)) + theme_minimal(base_size = 12) + theme( axis.text = element_blank(), axis.ticks = element_blank(), panel.grid = element_blank(), axis.title = element_blank(), plot.margin = margin(t = 2, r = 12, b = 2, l = 12) ) + labs(title = paste0(titel, ": ", wert, " / ", max_wert)) } # UI #### app_css = " body { font-family: 'Segoe UI', Arial, sans-serif; background: #f5f5f5; } .app-header { background: #8B2635; color: white; padding: 18px 24px 14px; margin-bottom: 20px; border-radius: 0 0 6px 6px; } .app-header h2 { margin: 0; font-size: 1.5rem; font-weight: 600; } .app-header p { margin: 4px 0 0; opacity: 0.85; font-size: 0.9rem; } .input-panel { background: white; border-radius: 6px; padding: 16px 20px; margin-bottom: 16px; box-shadow: 0 1px 3px rgba(0,0,0,.12); display: flex; align-items: flex-end; gap: 12px; flex-wrap: wrap; } .input-panel .form-group { margin-bottom: 0; } .input-panel label { font-weight: 600; color: #333; } .btn-laden { background: #8B2635 !important; color: white !important; border: none !important; border-radius: 4px !important; padding: 8px 20px !important; font-weight: 600 !important; cursor: pointer; } .btn-laden:hover { background: #6d1e29 !important; } .input-panel .btn-default { background: #8B2635 !important; color: white !important; border: none !important; border-radius: 4px !important; padding: 8px 20px !important; font-weight: 600 !important; } .input-panel .btn-default: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; } .kontext-zeile { display: flex; gap: 8px; align-items: baseline; padding: 4px 0; color: #444; font-size: 0.93em; } .kontext-label { font-weight: 600; color: #333; min-width: 220px; } .vorfall-box { background: #FAFAFA; border-left: 5px solid #8B2635; border-radius: 4px; padding: 12px 16px; margin-bottom: 14px; color: #333; font-size: 0.93em; line-height: 1.5; } .vorfall-label { font-weight: 700; color: #8B2635; font-size: 0.78em; text-transform: uppercase; letter-spacing: 0.03em; margin-bottom: 4px; } .gauge-zeile { margin-bottom: 4px; } .diagnose-box { border-radius: 6px; padding: 14px 18px; margin: 12px 0; border-left: 5px solid; } .diagnose-titel { font-weight: 700; font-size: 1.05rem; margin-bottom: 6px; } .diagnose-hinweis { font-size: 0.93em; line-height: 1.55; } .diagnose-disclaimer { font-size: 0.82em; color: #777; font-style: italic; margin-top: 10px; border-top: 1px solid rgba(0,0,0,.1); padding-top: 8px; } .diagnose-ja { background: #FFEBEE; border-color: #EF9A9A; color: #B71C1C; } .diagnose-nein { background: #E8F5E9; border-color: #A5D6A7; color: #2E7D32; } .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: 26px; flex-shrink: 0; } .item-text { flex: 1; color: #333; font-size: 0.92em; } .stufe-badge { border-radius: 4px; padding: 2px 9px; font-weight: 700; font-size: 0.82em; white-space: nowrap; display: inline-block; flex-shrink: 0; } .stufe-badge-0 { background: #4CAF50; color: white; } .stufe-badge-1 { background: #F48FB1; color: #333333; } .stufe-badge-2 { background: #EF5350; color: white; } .stufe-badge-3 { background: #B71C1C; color: white; } .score-zahl { font-size: 2.2rem; font-weight: 800; color: #8B2635; } " 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("IES-R - Impact of Event Scale - Revised"), tags$p("Deutsche Version, 22 Items | Weiss und Marmar 1997 | Uebersetzung Maercker") ), div(class = "container-fluid", div(class = "input-panel", div(style = "min-width: 360px; white-space: nowrap;", textInput("pseudonym", label = tagList( "Pseudonym", tags$span(style = "font-weight: normal; font-style: italic; font-size: 0.78em; color: #888; margin-left: 4px; white-space: nowrap;", "optional, hat Vorrang vor Chiffre") ), placeholder = "optional", width = "340px") ), div(style = "min-width: 200px;", textInput("chiffre", label = "Patientenchiffre", placeholder = "z.B. P000123", width = "100%") ), actionButton("btn_suchen", "Auswerten", class = "btn btn-primary btn-laden"), div(style = "margin-left: auto;", downloadButton("download_word", "Word-Export (.docx)") ) ), uiOutput("fehler_ui"), uiOutput("warnung_ui"), uiOutput("ergebnis_ui") ) ) # Word-Export #### erstelle_iesr_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_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777") fp_bold_inline = fp_text(bold = TRUE, font.size = 11) klass_key = if (isTRUE(erg$verdacht_ptbs)) "ja" else "nein" klass_farbe = IESR_KLASSIFIKATION_WORD_FARBEN[[klass_key]] fp_klass_titel = fp_text(bold = TRUE, font.size = 12, color = klass_farbe$text, shading.color = klass_farbe$bg) fp_klass_text = fp_text(font.size = 11, color = klass_farbe$text, shading.color = klass_farbe$bg) doc = body_add_fpar(doc, fpar(ftext("IES-R - Einzelauswertung", 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) )) if (!is.null(erg$info_mehrere)) { doc = body_add_fpar(doc, fpar( ftext(erg$info_mehrere, fp_text(font.size = 10, italic = TRUE, color = "#555555")) )) } doc = body_add_par(doc, "", style = "Normal") doc = body_add_fpar(doc, fpar(ftext("Berichtetes Ereignis", fp_abschnitt))) doc = body_add_fpar(doc, fpar( ftext(if (is.na(erg$vorfall) || nchar(trimws(erg$vorfall)) == 0) "Keine Angabe." else erg$vorfall, fp_normal) )) doc = body_add_par(doc, "", style = "Normal") doc = body_add_fpar(doc, fpar(ftext("Subskalen und Gesamtscore", fp_abschnitt))) doc = body_add_fpar(doc, fpar( ftext("Intrusion: ", fp_label), ftext(paste0(erg$intrusion_summe, " / ", IESR_SUBSKALEN_MAX[["Intrusion"]]), fp_normal) )) doc = body_add_fpar(doc, fpar( ftext("Vermeidung: ", fp_label), ftext(paste0(erg$vermeidung_summe, " / ", IESR_SUBSKALEN_MAX[["Vermeidung"]]), fp_normal) )) doc = body_add_fpar(doc, fpar( ftext("Uebererregung: ", fp_label), ftext(paste0(erg$uebererregung_summe, " / ", IESR_SUBSKALEN_MAX[["Uebererregung"]]), fp_normal) )) doc = body_add_fpar(doc, fpar( ftext("Gesamtscore: ", fp_label), ftext(paste0(erg$gesamtscore, " / ", IESR_GESAMT_MAX), fp_normal) )) doc = body_add_par(doc, "", style = "Normal") doc = body_add_fpar(doc, fpar(ftext("Diagnoseformel (Maercker und Schuetzwohl, 1998)", fp_abschnitt))) doc = body_add_fpar(doc, fpar( ftext("X = -0.02 * Intrusion + 0.07 * Vermeidung + 0.15 * Uebererregung - 4.36", fp_normal) )) doc = body_add_fpar(doc, fpar( ftext("X", fp_bold_inline), ftext(paste0( " = -0.02 * ", erg$intrusion_summe, " + 0.07 * ", erg$vermeidung_summe, " + 0.15 * ", erg$uebererregung_summe, " - 4.36 = " ), fp_normal), ftext(sprintf("%.2f", erg$x_wert), fp_bold_inline) )) doc = body_add_fpar(doc, fpar( ftext(if (isTRUE(erg$verdacht_ptbs)) "Verdachtsdiagnose auf posttraumatische Belastungsstoerung (X > 0)." else "Kein Hinweis auf eine Verdachtsdiagnose (X <= 0).", fp_klass_titel) )) doc = body_add_par(doc, "", style = "Normal") doc = body_add_fpar(doc, fpar(ftext("IES-R Einzelitems", fp_abschnitt))) for (i in seq_len(22)) { stufe = erg$stufen[i] anker = erg$anker_texte[i] punkt = erg$punkte[i] sk = if (!is.na(stufe) && stufe >= 0L && stufe <= 3L) as.character(stufe) else "0" anker_txt = if (!is.na(anker)) anker else IESR_ANTWORT_TEXTE[as.integer(sk) + 1L] item_txt = if (!is.na(erg$item_texte[i])) erg$item_texte[i] else paste0("Item ", i) fp_badge = fp_text( color = IESR_BADGE_TEXT_FARBEN[[sk]], bold = TRUE, shading.color = IESR_BADGE_FARBEN[[sk]], font.size = 10 ) doc = body_add_fpar(doc, fpar( ftext(paste0(i, ". ", item_txt, " "), fp_normal), ftext(paste0(" ", anker_txt, " (", punkt, " Punkte) "), fp_badge) )) } doc = body_add_par(doc, "", style = "Normal") doc = body_add_fpar(doc, fpar(ftext(IESR_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))) } }) ergebnis_r = eventReactive(input$btn_suchen, { chiffre = toupper(trimws(input$chiffre)) if (nchar(trimws(input$pseudonym)) == 0 && nchar(chiffre) == 0) return(list(error = "Bitte Chiffre oder Pseudonym eingeben.")) if (nchar(trimws(input$pseudonym)) == 0 && !grepl("^[A-Z][0-9]{6}$", chiffre)) return(list(error = paste0( "Ungueltige Chiffre. Erwartet: ein Grossbuchstabe + 6 Ziffern (z.B. P000123)."))) if (!file.exists(PFAD_DOWNLOAD_SKRIPT)) return(list(error = paste0( "Download-Skript nicht gefunden:\n", PFAD_DOWNLOAD_SKRIPT))) if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) return(list(error = 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(error = 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(error = paste0("Fehler im Pseudonym-Skript: ", ok_ps$msg))) if (!exists("daten_iesr", envir = .GlobalEnv)) return(list(error = paste0( "Objekt 'daten_iesr' nach dem Sourcen nicht gefunden. Bitte Download-Skript pruefen."))) if (!exists("pseudo", envir = .GlobalEnv)) return(list(error = paste0( "Objekt 'pseudo' nach dem Sourcen nicht gefunden. Bitte Pseudonym-Skript pruefen."))) daten_iesr = get("daten_iesr", 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 && nchar(trimws(input$pseudonym)) == 0) return(list(error = 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_iesr[daten_iesr$session %in% alle_session_ids, ] if (nrow(treffer_dat) == 0) return(list(error = paste0( "Kein IES-R-Datensatz gefunden fuer ", if (nchar(trimws(input$pseudonym)) > 0) paste0("Pseudonym '", trimws(input$pseudonym), "'") else paste0("Chiffre '", chiffre, "' (", length(alle_session_ids), " Pseudonym(e) geprueft)"), "."))) info_mehrere = NULL if (nrow(treffer_dat) > 1 && nchar(trimws(input$pseudonym)) == 0) { 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] } else if (nrow(treffer_dat) > 1) { treffer_dat = treffer_dat[order(treffer_dat$created, decreasing = TRUE), ][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") ) vorfall = as.character(zeile[["iesr_vorfall"]][1]) item_texte = sapply(seq_len(22), function(i) { var = paste0("iesr_", sprintf("%02d", i)) clean_item_label(attr(daten_iesr[[var]], "label")) }) stufen = sapply(seq_len(22), function(i) { var = paste0("iesr_", sprintf("%02d", i)) iesr_get_level(daten_iesr[[var]], zeile[[var]]) }) anker_texte = sapply(seq_len(22), function(i) { var = paste0("iesr_", sprintf("%02d", i)) iesr_get_anker(daten_iesr[[var]], zeile[[var]]) }) punkte = sapply(stufen, function(s) { if (is.na(s)) return(NA_real_) as.numeric(IESR_PUNKTE_LOOKUP[[as.character(s)]]) }) intrusion_summe = sum(punkte[IESR_SUBSKALEN$Intrusion], na.rm = TRUE) vermeidung_summe = sum(punkte[IESR_SUBSKALEN$Vermeidung], na.rm = TRUE) uebererregung_summe = sum(punkte[IESR_SUBSKALEN$Uebererregung], na.rm = TRUE) gesamtscore = intrusion_summe + vermeidung_summe + uebererregung_summe x_wert = -0.02 * intrusion_summe + 0.07 * vermeidung_summe + 0.15 * uebererregung_summe - 4.36 verdacht_ptbs = x_wert > 0 list( chiffre = chiffre, datum_str = datum_str, info_mehrere = info_mehrere, vorfall = vorfall, item_texte = item_texte, stufen = stufen, anker_texte = anker_texte, punkte = punkte, intrusion_summe = intrusion_summe, vermeidung_summe = vermeidung_summe, uebererregung_summe = uebererregung_summe, gesamtscore = gesamtscore, x_wert = x_wert, verdacht_ptbs = verdacht_ptbs, error = NULL ) }) output$fehler_ui = renderUI({ req(input$btn_suchen) erg = ergebnis_r() if (!is.null(erg$error)) div(class = "alert-fehler", erg$error) }) output$warnung_ui = renderUI({ req(input$btn_suchen) erg = ergebnis_r() if (!is.null(erg$error) || is.null(erg$info_mehrere)) return(NULL) div(class = "alert-warnung", erg$info_mehrere) }) output$ergebnis_ui = renderUI({ req(input$btn_suchen) erg = ergebnis_r() if (!is.null(erg$error)) return(NULL) klass_klasse = if (isTRUE(erg$verdacht_ptbs)) "diagnose-ja" else "diagnose-nein" items_ui = lapply(seq_len(22), function(i) { stufe = erg$stufen[i] anker = erg$anker_texte[i] punkt = erg$punkte[i] sk = if (!is.na(stufe) && stufe >= 0L && stufe <= 3L) as.character(stufe) else "0" anker_txt = if (!is.na(anker)) anker else IESR_ANTWORT_TEXTE[as.integer(sk) + 1L] item_txt = if (!is.na(erg$item_texte[i])) erg$item_texte[i] else paste0("Item ", i) punkt_txt = if (is.na(punkt)) "k. A." else paste0(anker_txt, " (", punkt, " Punkte)") div(class = "item-zeile", div(class = "item-nr", paste0(i, ".")), div(class = "item-text", item_txt), span(class = paste0("stufe-badge stufe-badge-", sk), punkt_txt) ) }) div(class = "abschnitt-karte", div(class = "abschnitt-titel", "IES-R"), div(class = "meta-block", tags$strong("Chiffre: "), erg$chiffre, tags$span(" | ", style = "color:#ccc;"), tags$strong("Ausfuelldatum: "), erg$datum_str ), div(class = "vorfall-box", div(class = "vorfall-label", "Vom Probanden berichtetes Ereignis"), div(if (is.na(erg$vorfall) || nchar(trimws(erg$vorfall)) == 0) "Keine Angabe." else erg$vorfall) ), tags$hr(), tags$h5("Subskalen und Gesamtscore"), div(class = "gauge-zeile", plotOutput("gauge_intrusion", height = "70px") ), div(class = "gauge-zeile", plotOutput("gauge_vermeidung", height = "70px") ), div(class = "gauge-zeile", plotOutput("gauge_uebererregung", height = "70px") ), div(class = "gauge-zeile", plotOutput("gauge_gesamt", height = "70px") ), tags$hr(), tags$h5("Diagnostische Einordnung"), div(class = paste0("diagnose-box ", klass_klasse), div(class = "diagnose-titel", if (isTRUE(erg$verdacht_ptbs)) "Verdachtsdiagnose auf posttraumatische Belastungsstoerung" else "Kein Hinweis auf eine Verdachtsdiagnose" ), div(class = "diagnose-hinweis", tags$div("X = -0.02 * Intrusion + 0.07 * Vermeidung + 0.15 * Uebererregung - 4.36", style = "color:#777; font-size:0.9em; margin-bottom:2px;"), tags$div( tags$strong("X"), paste0( " = -0.02 * ", erg$intrusion_summe, " + 0.07 * ", erg$vermeidung_summe, " + 0.15 * ", erg$uebererregung_summe, " - 4.36 = " ), tags$strong(sprintf("%.2f", erg$x_wert)), if (isTRUE(erg$verdacht_ptbs)) " (X > 0)" else " (X <= 0)" ) ), div(class = "diagnose-disclaimer", IESR_DISCLAIMER) ), tags$hr(), tags$h5("IES-R Einzelitems"), div(items_ui) ) }) output$gauge_intrusion = renderPlot({ req(input$btn_suchen) erg = ergebnis_r() req(is.null(erg$error)) make_gauge_iesr(erg$intrusion_summe, IESR_SUBSKALEN_MAX[["Intrusion"]], "Intrusion") }, bg = "transparent") output$gauge_vermeidung = renderPlot({ req(input$btn_suchen) erg = ergebnis_r() req(is.null(erg$error)) make_gauge_iesr(erg$vermeidung_summe, IESR_SUBSKALEN_MAX[["Vermeidung"]], "Vermeidung") }, bg = "transparent") output$gauge_uebererregung = renderPlot({ req(input$btn_suchen) erg = ergebnis_r() req(is.null(erg$error)) make_gauge_iesr(erg$uebererregung_summe, IESR_SUBSKALEN_MAX[["Uebererregung"]], "Uebererregung") }, bg = "transparent") output$gauge_gesamt = renderPlot({ req(input$btn_suchen) erg = ergebnis_r() req(is.null(erg$error)) make_gauge_iesr(erg$gesamtscore, IESR_GESAMT_MAX, "Gesamtscore") }, bg = "transparent") output$download_word = downloadHandler( filename = function() { erg = tryCatch(ergebnis_r(), error = function(e) NULL) chiffre = if (is.list(erg) && is.null(erg$error) && nchar(erg$chiffre) > 0) erg$chiffre else "export" datum = if (is.list(erg) && is.null(erg$error) && !is.null(erg$datum_str)) tryCatch( format(as.Date(erg$datum_str, "%d.%m.%Y"), "%Y%m%d"), error = function(e) format(Sys.Date(), "%Y%m%d") ) else format(Sys.Date(), "%Y%m%d") paste0("IESR_", chiffre, "_", datum, ".docx") }, content = function(file) { erg = tryCatch(ergebnis_r(), error = function(e) NULL) daten_ok = is.list(erg) && is.null(erg$error) 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_iesr_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)