# Präambel #### AKZENT_FARBE = "#8B2635" PFAD_DOWNLOAD_SKRIPT = "../API/get_data_pcl5.R" PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R" PCL5_DISCLAIMER = paste0( "Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ", "keine klinische Diagnose. Die Interpretation der Ergebnisse obliegt der ", "behandelnden Person. Auswertungslogik gemaess 'Anwendung und Auswertung PCL-5'." ) 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 #### PCL5_ITEM_TEXTE = c( "Wiederholte, beunruhigende und ungewollte Erinnerungen an das belastende Erlebnis?", "Wiederholte, beunruhigende Traeume von dem belastenden Erlebnis?", "Sich ploetzlich fuehlen oder sich verhalten, als ob das belastende Erlebnis tatsaechlich wieder stattfinden wuerde?", "Sich emotional sehr belastet fuehlen, wenn Sie etwas an das Erlebnis erinnert hat?", "Starke koerperliche Reaktionen haben, wenn Sie etwas an das belastende Erlebnis erinnert hat?", "Vermeidung von Erinnerungen, Gedanken oder Gefuehlen in Bezug auf das belastende Erlebnis?", "Vermeidung aeusserer Ausloser fuer Erinnerungen an das belastende Erlebnis?", "Schwierigkeiten, sich an wichtige Teile des belastenden Erlebnisses zu erinnern?", "Starke negative Ueberzeugungen ueber sich selbst, andere Menschen oder die Welt haben?", "Sich selbst oder jemand anderem Vorwuerfe machen in Bezug auf das belastende Erlebnis?", "Starke negative Gefuehle haben, wie Angst, Schrecken, Aerger, Schuld oder Scham?", "Verlust von Interesse an Aktivitaeten, die Ihnen frueher Spass gemacht haben?", "Sich von anderen Menschen entfernt oder wie abgeschnitten fuehlen?", "Schwierigkeiten, positive Gefuehle zu erleben?", "Reizbares Verhalten, Wutausbrueche oder aggressives Verhalten?", "Zu viele Risiken eingehen oder Dinge tun, die Ihnen Schaden zufuegen koennten?", "In erhoehter Alarmbereitschaft, wachsam oder auf der Hut sein?", "Sich nervoes oder schreckhaft fuehlen?", "Konzentrationsschwierigkeiten haben?", "Schwierigkeiten, ein- oder durchzuschlafen?" ) PCL5_STUFEN_TEXT = c( "0" = "ueberhaupt nicht", "1" = "ein wenig", "2" = "ziemlich", "3" = "stark", "4" = "sehr stark" ) PCL5_BADGE_FARBEN = c( "0" = "#4CAF50", "1" = "#F48FB1", "2" = "#EF5350", "3" = "#B71C1C", "4" = "#4A0000" ) PCL5_BADGE_TEXT_FARBEN = c( "0" = "white", "1" = "#333333", "2" = "white", "3" = "white", "4" = "white" ) CLUSTER_B = 1:5 CLUSTER_C = 6:7 CLUSTER_D = 8:14 CLUSTER_E = 15:20 # labels-Attribut aus Originalspalte lesen, weil haven-Attribute beim Subsetting # zwar erhalten bleiben, aber das Original die zuverlaessigere Quelle ist. pcl5_get_level = function(original_col, zeile_val) { if (is.null(zeile_val) || length(zeile_val) == 0) return(NA_integer_) if (is.na(zeile_val[1])) return(NA_integer_) lbl_attr = attr(original_col, "labels") if (!is.null(lbl_attr) && length(lbl_attr) > 0) { lbl_plain = as.vector(lbl_attr) names(lbl_plain) = names(lbl_attr) lbl_sorted = sort(lbl_plain) pos = which(lbl_sorted == as.numeric(zeile_val[1])) if (length(pos) > 0) return(as.integer(pos[1]) - 1L) } NA_integer_ } dsm5_check = function(levels) { b_count = sum(levels[CLUSTER_B] >= 2, na.rm = TRUE) c_count = sum(levels[CLUSTER_C] >= 2, na.rm = TRUE) d_count = sum(levels[CLUSTER_D] >= 2, na.rm = TRUE) e_count = sum(levels[CLUSTER_E] >= 2, na.rm = TRUE) list( b_count = b_count, b_ok = b_count >= 1, c_count = c_count, c_ok = c_count >= 1, d_count = d_count, d_ok = d_count >= 2, e_count = e_count, e_ok = e_count >= 2, gesamt = (b_count >= 1) && (c_count >= 1) && (d_count >= 2) && (e_count >= 2) ) } make_gauge_plot = function(score) { ggplot() + geom_rect(aes(xmin = 0, xmax = 33, ymin = 0, ymax = 1), fill = "#E8F5E9", color = NA) + geom_rect(aes(xmin = 33, xmax = 80, ymin = 0, ymax = 1), fill = "#FFEBEE", color = NA) + geom_rect(aes(xmin = 0, xmax = 80, ymin = 0, ymax = 1), fill = NA, color = "#9E9E9E", linewidth = 0.6) + geom_vline(xintercept = 33, color = "#E65100", linetype = "dashed", linewidth = 1) + geom_segment(aes(x = score, xend = score, y = -0.25, yend = 1.25), color = AKZENT_FARBE, linewidth = 2.5) + geom_label(aes(x = score, y = 1.6, label = paste0("Score: ", score)), fill = AKZENT_FARBE, color = "white", fontface = "bold", linewidth = 0, size = 4) + annotate("text", x = 33, y = -0.55, label = "Cutoff: 33", color = "#E65100", size = 3.2, hjust = 0.5) + annotate("text", x = 16, y = 0.5, label = "< 33", color = "#2E7D32", size = 3.5, fontface = "italic") + annotate("text", x = 57, y = 0.5, label = ">= 33", color = "#B71C1C", size = 3.5, fontface = "italic") + scale_x_continuous(limits = c(0, 83), breaks = c(0, 10, 20, 33, 40, 50, 60, 70, 80)) + scale_y_continuous(limits = c(-0.8, 2.0)) + theme_minimal(base_size = 12) + theme( axis.text.y = element_blank(), axis.ticks.y = element_blank(), panel.grid.major.y = element_blank(), panel.grid.minor = element_blank(), axis.title.y = element_blank(), plot.margin = margin(t = 5, r = 10, b = 5, l = 10) ) + labs(x = "PCL-5 Summenscore (0-80)", y = NULL) } # 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; } .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: #FFFDE7; border-left: 5px solid #F9A825; padding: 10px 16px; border-radius: 4px; color: #555; margin-bottom: 12px; font-size: 0.93em; } .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; } .cluster-box { display: inline-block; padding: 10px 14px; border-radius: 6px; margin: 4px; text-align: center; min-width: 135px; vertical-align: top; } .cluster-ok { background: #E8F5E9; border: 1px solid #A5D6A7; } .cluster-nok { background: #FFEBEE; border: 1px solid #EF9A9A; } .cluster-name { font-weight: 700; font-size: 0.95em; color: #333; } .cluster-score { font-size: 0.9em; color: #555; margin: 2px 0; } .cluster-kriterium { font-size: 0.82em; font-weight: 600; } .cluster-kriterium-ok { color: #2E7D32; } .cluster-kriterium-nok { color: #C62828; } .dsm5-ergebnis { text-align: center; padding: 14px; border-radius: 6px; margin: 10px 0; font-size: 1.05rem; font-weight: 700; } .dsm5-erfuellt { background: #FFEBEE; color: #B71C1C; border: 2px solid #EF9A9A; } .dsm5-nichterfuellt { background: #E8F5E9; color: #2E7D32; border: 2px solid #A5D6A7; } .dsm5-disclaimer { font-size: 0.82em; color: #777; font-style: italic; margin-top: 8px; border-top: 1px solid #eee; padding-top: 8px; } .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: 28px; } .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; } .stufe-badge-0 { background: #4CAF50; color: white; } .stufe-badge-1 { background: #F48FB1; color: #333; } .stufe-badge-2 { background: #EF5350; color: white; } .stufe-badge-3 { background: #B71C1C; color: white; } .stufe-badge-4 { background: #4A0000; color: white; } .score-zahl { font-size: 2.2rem; font-weight: 800; color: #8B2635; } .cutoff-info { font-size: 0.88em; color: #555; margin-top: 4px; } " 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("PCL-5 - Verlaufstestung (Einzelauswertung)"), tags$p("Anzeige des jeweils neuesten Messzeitpunkts") ), 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: 180px;", textInput("chiffre", label = "Patientenchiffre", placeholder = "z.B. P000123", width = "100%") ), actionButton("btn_suchen", "Daten laden", class = "btn btn-primary btn-laden"), div(style = "margin-left: auto;", downloadButton("download_word", "Word-Bericht herunterladen", style = paste0("background:", AKZENT_FARBE, "; color:white; border:none;", " font-weight:600; padding:8px 20px; border-radius:4px;") ) ) ), uiOutput("fehler_ui"), uiOutput("info_ui"), uiOutput("pcl5_ui") ) ) # Word-Export #### erstelle_pcl5_docx = function(d) { 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_klein = fp_text(font.size = 9, italic = TRUE, color = "#666666") fp_score_gut = fp_text(bold = TRUE, font.size = 12, color = "#2E7D32") fp_score_krit = fp_text(bold = TRUE, font.size = 12, color = "#C62828") fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#888888") doc = body_add_fpar(doc, fpar(ftext("PCL-5 Verlaufstestung - Einzelauswertung", fp_titel))) doc = body_add_fpar(doc, fpar(ftext(paste0("Chiffre: ", d$chiffre, " | Messzeitpunkt: ", d$datum_str), fp_normal))) if (!is.null(d$info_mehrere)) { doc = body_add_fpar(doc, fpar(ftext(d$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("PCL-5: Auswertung", fp_abschnitt))) score = d$pcl5$summenscore fp_s = if (isTRUE(score >= 33)) fp_score_krit else fp_score_gut doc = body_add_fpar(doc, fpar( ftext("Summenscore: ", fp_label), ftext(paste0(score, " / 80"), fp_s) )) cutoff_info = if (isTRUE(score >= 33)) "Cutoff >= 33: Weitere psychometrische Untersuchung empfohlen." else "Unterhalb des Cutoffs von 33." doc = body_add_fpar(doc, fpar(ftext(cutoff_info, fp_normal))) doc = body_add_par(doc, "", style = "Normal") doc = body_add_fpar(doc, fpar(ftext("Cluster-Subscores", fp_abschnitt))) cluster_info = list( list(name = "Cluster B (Intrusion, Items 1-5)", key = "b", max = 20, min_ok = 1), list(name = "Cluster C (Vermeidung, Items 6-7)", key = "c", max = 8, min_ok = 1), list(name = "Cluster D (Kognition/Stimmung, Items 8-14)", key = "d", max = 28, min_ok = 2), list(name = "Cluster E (Arousal, Items 15-20)", key = "e", max = 24, min_ok = 2) ) dsm = d$pcl5$dsm5 for (cl in cluster_info) { cs = d$pcl5$cluster[[cl$key]] cnt = dsm[[paste0(cl$key, "_count")]] ok = isTRUE(dsm[[paste0(cl$key, "_ok")]]) haken = if (ok) " - Kriterium erfuellt" else " - Kriterium nicht erfuellt" doc = body_add_fpar(doc, fpar( ftext(paste0(cl$name, ": "), fp_label), ftext(paste0(cs$score, " / ", cl$max, " Pkt | ", cnt, " von mind. ", cl$min_ok, haken), fp_normal) )) } doc = body_add_par(doc, "", style = "Normal") gesamt_ok = isTRUE(dsm$gesamt) fp_dsm = if (gesamt_ok) fp_score_krit else fp_score_gut dsm_txt = if (gesamt_ok) "Erfuellt (Kriterien B, C, D, E alle erfuellt)" else "Nicht erfuellt" doc = body_add_fpar(doc, fpar( ftext("Vorlaeufige DSM-5-Kriterienregel: ", fp_label), ftext(dsm_txt, fp_dsm) )) doc = body_add_par(doc, "", style = "Normal") doc = body_add_fpar(doc, fpar(ftext("PCL-5 Einzelitems", fp_abschnitt))) for (i in 1:20) { lvl = d$pcl5$levels[i] lvl_key = if (!is.na(lvl) && isTRUE(lvl >= 0) && isTRUE(lvl <= 4)) as.character(lvl) else "0" fp_badge = fp_text( color = PCL5_BADGE_TEXT_FARBEN[[lvl_key]], bold = TRUE, shading.color = PCL5_BADGE_FARBEN[[lvl_key]], font.size = 10 ) doc = body_add_fpar(doc, fpar( ftext(paste0(i, ". ", PCL5_ITEM_TEXTE[i], " "), fp_normal), ftext(paste0(" ", PCL5_STUFEN_TEXT[[lvl_key]], " "), fp_badge) )) } doc = body_add_par(doc, "", style = "Normal") doc = body_add_fpar(doc, fpar(ftext(PCL5_DISCLAIMER, fp_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))) } }) patientendaten = eventReactive(input$btn_suchen, { chiffre = toupper(trimws(input$chiffre)) if ((nchar(trimws(input$pseudonym)) == 0 && nchar(chiffre) == 0)) return(list(error = "Bitte eine Patientenchiffre eingeben.")) if (!(nchar(trimws(input$pseudonym)) > 0 || grepl("^[A-Z][0-9]{6}$", chiffre))) return(list(error = paste0( "Ungueltige Chiffre \"", chiffre, "\". ", "Erwartet: ein Grossbuchstabe gefolgt von 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))) res_dl = tryCatch({ source(PFAD_DOWNLOAD_SKRIPT, local = FALSE) list(ok = TRUE) }, error = function(e) list(ok = FALSE, msg = e$message)) if (!res_dl$ok) return(list(error = paste0("Fehler im Download-Skript: ", res_dl$msg))) basis_dir = normalizePath(dirname(PFAD_PSEUDONYM_SKRIPT)) db_dir = NULL current = basis_dir for (i in 0:5) { if (file.exists(file.path(current, "pseudonyme.db"))) { db_dir = current break } parent = dirname(current) if (parent == current) break current = parent } alter_wd = getwd() on.exit(setwd(alter_wd), add = TRUE) setwd(if (!is.null(db_dir)) db_dir else basis_dir) res_ps = tryCatch({ 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])) } list(ok = TRUE) }, error = function(e) list(ok = FALSE, msg = e$message)) if (!res_ps$ok) return(list(error = paste0("Fehler im Pseudonym-Skript: ", res_ps$msg))) if (!exists("daten_pcl5", envir = .GlobalEnv)) return(list(error = "Objekt 'daten_pcl5' nach dem Sourcen nicht gefunden.")) if (!exists("pseudo", envir = .GlobalEnv)) return(list(error = "Objekt 'pseudo' nach dem Sourcen nicht gefunden.")) daten = get("daten_pcl5", envir = .GlobalEnv) pseudo_df = get("pseudo", envir = .GlobalEnv) treffer_ps = pseudo_df[pseudo_df$chiffre == chiffre, ] if (nrow(treffer_ps) == 0) return(list(error = paste0( "Chiffre '", chiffre, "' nicht in der Pseudonym-Datenbank gefunden."))) alle_session_ids = unique(treffer_ps$pseudonym) if (nchar(trimws(input$pseudonym)) > 0) alle_session_ids = trimws(input$pseudonym) treffer_dat = daten[daten$session %in% alle_session_ids, ] if (nrow(treffer_dat) == 0) return(list(error = paste0( "Keine Daten fuer Chiffre '", chiffre, "' in daten_pcl5 gefunden. (", length(alle_session_ids), " Pseudonym(e) geprueft)"))) info_mehrere = NULL n_durchlaeufe = nrow(treffer_dat) if (n_durchlaeufe > 1) { treffer_dat = treffer_dat[order(treffer_dat$created, decreasing = TRUE), ] info_mehrere = paste0( "Es liegen ", n_durchlaeufe, " Durchlaufe vor. ", "Angezeigt wird der neueste vom ", format(treffer_dat$created[1], "%d.%m.%Y %H:%M"), "." ) 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") ) pcl5_levels = sapply(1:20, function(i) { var = paste0("pcl5_", sprintf("%02d", i)) pcl5_get_level(daten[[var]], zeile[[var]]) }) summenscore = sum(pcl5_levels, na.rm = TRUE) cluster_b_sum = sum(pcl5_levels[CLUSTER_B], na.rm = TRUE) cluster_c_sum = sum(pcl5_levels[CLUSTER_C], na.rm = TRUE) cluster_d_sum = sum(pcl5_levels[CLUSTER_D], na.rm = TRUE) cluster_e_sum = sum(pcl5_levels[CLUSTER_E], na.rm = TRUE) pcl5 = list( levels = pcl5_levels, summenscore = summenscore, cluster = list( b = list(score = cluster_b_sum, max = 20), c = list(score = cluster_c_sum, max = 8), d = list(score = cluster_d_sum, max = 28), e = list(score = cluster_e_sum, max = 24) ), dsm5 = dsm5_check(pcl5_levels) ) list( chiffre = chiffre, datum_str = datum_str, info_mehrere = info_mehrere, pcl5 = pcl5, error = NULL ) }) output$fehler_ui = renderUI({ req(input$btn_suchen) d = patientendaten() if (!is.null(d$error)) div(class = "alert-fehler", d$error) }) output$info_ui = renderUI({ req(input$btn_suchen) d = patientendaten() if (!is.null(d$error) || is.null(d$info_mehrere)) return(NULL) div(class = "alert-warnung", d$info_mehrere) }) output$pcl5_ui = renderUI({ req(input$btn_suchen) d = patientendaten() if (!is.null(d$error)) return(NULL) p = d$pcl5 score = p$summenscore cutoff_ok = isTRUE(score >= 33) dsm5 = p$dsm5 dsm5_ok = isTRUE(dsm5$gesamt) cluster_defs = list( list(name1 = "Cluster B", name2 = "(Intrusion)", key = "b", min_ok = 1), list(name1 = "Cluster C", name2 = "(Vermeidung)", key = "c", min_ok = 1), list(name1 = "Cluster D", name2 = "(Kognition)", key = "d", min_ok = 2), list(name1 = "Cluster E", name2 = "(Arousal)", key = "e", min_ok = 2) ) cluster_boxes = lapply(cluster_defs, function(cl) { dat = p$cluster[[cl$key]] cnt = dsm5[[paste0(cl$key, "_count")]] ok_flg = isTRUE(dsm5[[paste0(cl$key, "_ok")]]) div(class = paste0("cluster-box ", if (ok_flg) "cluster-ok" else "cluster-nok"), div(class = "cluster-name", tags$strong(cl$name1), tags$br(), cl$name2), div(class = "cluster-score", paste0(dat$score, " / ", dat$max, " Pkt")), div(class = paste0("cluster-kriterium ", if (ok_flg) "cluster-kriterium-ok" else "cluster-kriterium-nok"), paste0(cnt, " von mind. ", cl$min_ok, if (ok_flg) " ✓" else " ✗")) ) }) dsm5_klasse = if (dsm5_ok) "dsm5-erfuellt" else "dsm5-nichterfuellt" dsm5_text = if (dsm5_ok) "Voraussetzungen der DSM-5-Kriterienregel erfuellt" else "Voraussetzungen der DSM-5-Kriterienregel nicht erfuellt" pcl5_items_ui = lapply(1:20, function(i) { lvl = p$levels[i] lvl_key = if (!is.na(lvl) && isTRUE(lvl >= 0) && isTRUE(lvl <= 4)) as.character(lvl) else "0" cluster_lbl = if (i %in% CLUSTER_B) "B" else if (i %in% CLUSTER_C) "C" else if (i %in% CLUSTER_D) "D" else "E" div(class = "item-zeile", div(class = "item-nr", paste0(i, ".")), div(class = "item-text", tags$small(paste0("[", cluster_lbl, "] "), style = "color:#999;"), PCL5_ITEM_TEXTE[i]), div(span(class = paste0("stufe-badge stufe-badge-", lvl_key), PCL5_STUFEN_TEXT[[lvl_key]])) ) }) div(class = "abschnitt-karte", div(class = "abschnitt-titel", "PCL-5"), div(class = "meta-block", tags$strong("Chiffre: "), d$chiffre, tags$span(" | ", style = "color:#ccc;"), tags$strong("Messzeitpunkt: "), d$datum_str ), tags$hr(), fluidRow( column(3, div( div(class = "score-zahl", score), div("Summenscore (0-80)"), div(class = "cutoff-info", if (cutoff_ok) tags$span(style = "color:#B71C1C; font-weight:600;", ">= 33: Weitere Abklaerung empfohlen") else tags$span(style = "color:#2E7D32; font-weight:600;", "< 33: Unterhalb Cutoff") ) ) ), column(9, plotOutput("gauge_plot", height = "160px")) ), tags$hr(), div(style = "margin-bottom: 14px;", tags$h5("Cluster-Subscores und DSM-5-Kriterienregel"), div(style = "margin-bottom: 10px;", tagList(cluster_boxes)), div(class = paste0("dsm5-ergebnis ", dsm5_klasse), dsm5_text), div(class = "dsm5-disclaimer", "Hinweis: Diese Auswertung stellt kein automatisiertes klinisches Urteil dar. ", "Die Ergebnisse dienen als Orientierung fuer die klinische Einschaetzung ", "und ersetzen keine fachkundige diagnostische Beurteilung." ) ), tags$hr(), div(tags$h5("Einzelitems"), pcl5_items_ui) ) }) output$gauge_plot = renderPlot({ req(input$btn_suchen) d = patientendaten() req(is.null(d$error)) make_gauge_plot(d$pcl5$summenscore) }, bg = "transparent") output$download_word = downloadHandler( filename = function() { d = tryCatch(patientendaten(), error = function(e) NULL) if (!is.list(d) || !is.null(d$error)) return("PCL5_Auswertung.docx") chiffre_esc = gsub("[^A-Za-z0-9_-]", "_", d$chiffre) datum_fn = tryCatch( format(as.Date(d$datum_str, "%d.%m.%Y"), "%Y%m%d"), error = function(e) format(Sys.Date(), "%Y%m%d") ) paste0("PCL5_", chiffre_esc, "_", datum_fn, ".docx") }, content = function(file) { d = tryCatch(patientendaten(), error = function(e) NULL) if (!is.list(d) || !is.null(d$error)) { doc = read_docx() doc = body_add_par(doc, "Kein Datensatz geladen. Bitte zuerst Chiffre eingeben und 'Daten laden' klicken.", style = "Normal") print(doc, target = file) return() } doc = tryCatch( erstelle_pcl5_docx(d), error = function(e) { err_doc = read_docx() body_add_par(err_doc, paste0("Fehler beim Erstellen des Dokuments: ", e$message), style = "Normal") } ) print(doc, target = file) } ) } # Start #### shinyApp(ui, server)