server/DiagnostikApps
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Initial commit

Browse source
This commit is contained in:
Jonas Karneboge 2026-09-22 18:35:43 +02:00
commit 3cba772836
1341 changed files with 532924 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

BIN
PCL5/.RData Normal file
View file

Binary file not shown.

1
PCL5/.Rprofile Normal file
View file

@ -0,0 +1 @@
source("renv/activate.R")

13
PCL5/PCL5.Rproj Normal file
View file

@ -0,0 +1,13 @@
Version: 1.0
RestoreWorkspace: Default
SaveWorkspace: Default
AlwaysSaveHistory: Default
EnableCodeIndexing: Yes
UseSpacesForTab: Yes
NumSpacesForTab: 2
Encoding: UTF-8
RnwWeave: Sweave
LaTeX: pdfLaTeX

691
PCL5/app.R Normal file
View file

@ -0,0 +1,691 @@
# 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)

2879
PCL5/renv.lock Normal file
View file

File diff suppressed because it is too large Load diff

11
PCL5/setup_renv.R Normal file
View file

@ -0,0 +1,11 @@
# Einmalig ausfuehren, bevor die App zum ersten Mal gestartet wird.
# Initialisiert renv und installiert alle benoedigten Pakete.
renv::init()
pkgs <- c("shiny", "dplyr", "ggplot2", "haven", "officer")
install.packages(pkgs)
renv::snapshot()
message("Setup abgeschlossen. App starten mit: shiny::runApp()")