1034 lines
37 KiB
R
1034 lines
37 KiB
R
# Präambel ####
|
|
|
|
AKZENT_FARBE = "#8B2635"
|
|
|
|
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_scl90r.R"
|
|
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"
|
|
|
|
SCL90R_DISCLAIMER = paste0(
|
|
"Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
|
|
"keine klinische Diagnose. T-Zonen (T<60 / 60-70 / >70) sind heuristische ",
|
|
"Orientierungshilfen, keine klinisch validierten Grenzwerte. ",
|
|
"Die Interpretation der Ergebnisse obliegt der behandelnden Person."
|
|
)
|
|
|
|
library(shiny)
|
|
library(dplyr)
|
|
library(ggplot2)
|
|
library(haven)
|
|
library(officer)
|
|
library(rvg)
|
|
|
|
|
|
# Infrastruktur ####
|
|
|
|
APP_VERZEICHNIS = normalizePath(getwd())
|
|
norm_dir = APP_VERZEICHNIS
|
|
|
|
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 ####
|
|
|
|
# VLOOKUP-Bereichsabgleich: naechstkleinerer Rohwert, Clamping nach oben
|
|
lookup_twert = function(rohwert, tabelle, spalte) {
|
|
if (is.null(tabelle) || !(spalte %in% names(tabelle))) return(NA)
|
|
if (is.na(rohwert)) return(NA)
|
|
kandidaten = tabelle[tabelle$rohwert <= rohwert, ]
|
|
if (nrow(kandidaten) == 0) return(NA)
|
|
zeile = kandidaten[which.max(kandidaten$rohwert), ]
|
|
wert = zeile[[spalte]]
|
|
if (length(wert) == 0 || is.na(wert) || wert == "") return(NA)
|
|
as.numeric(wert)
|
|
}
|
|
|
|
norm_spalte = function(geschlecht_num, geschlecht_labels, bildung_num, bildung_labels) {
|
|
if (is.null(geschlecht_labels) || is.null(bildung_labels)) return("m_gesamt")
|
|
tryCatch({
|
|
g_factor = haven::as_factor(structure(geschlecht_num,
|
|
labels = geschlecht_labels,
|
|
class = "haven_labelled"))
|
|
b_factor = haven::as_factor(structure(bildung_num,
|
|
labels = bildung_labels,
|
|
class = "haven_labelled"))
|
|
g_lbl = tolower(as.character(g_factor))
|
|
b_lbl = tolower(as.character(b_factor))
|
|
g_code = if (grepl("weibl|female|frau|f$", g_lbl)) "f" else "m"
|
|
b_code = if (grepl("haupt|real|main|secondary", b_lbl)) "haupt_real"
|
|
else if (grepl("abitur|abi|high|gymn", b_lbl)) "abitur"
|
|
else if (grepl("hochschul|universit|uni|college|degree", b_lbl)) "hochschule"
|
|
else "gesamt"
|
|
paste0(g_code, "_", b_code)
|
|
}, error = function(e) "m_gesamt")
|
|
}
|
|
|
|
rohwert_aus_item = function(x) {
|
|
if (is.null(x) || (length(x) == 1 && is.na(x))) return(NA_real_)
|
|
val = as.numeric(x)
|
|
if (!is.na(val) && val >= 0 && val <= 4) return(val)
|
|
lbls = attr(x, "labels")
|
|
if (!is.null(lbls)) {
|
|
lbl_namen = names(lbls)
|
|
for (i in seq_along(lbl_namen)) {
|
|
m = regmatches(lbl_namen[i], regexpr("^(\\d+)\\)", lbl_namen[i]))
|
|
if (length(m) > 0 && lbls[[i]] == as.numeric(x)) {
|
|
return(as.numeric(sub("\\).*", "", m)))
|
|
}
|
|
}
|
|
}
|
|
val
|
|
}
|
|
|
|
berechne_auswertung = function(zeile, norm_spalten_name) {
|
|
items = sapply(1:90, function(i) {
|
|
col = sprintf("scl90_item%02d", i)
|
|
if (col %in% names(zeile)) rohwert_aus_item(zeile[[col]]) else NA_real_
|
|
})
|
|
names(items) = sprintf("%02d", 1:90)
|
|
|
|
ergebnis = list()
|
|
ergebnis$items = items
|
|
|
|
for (sk in names(subskalen)[names(subskalen) != "Zusatzitems"]) {
|
|
idx = subskalen[[sk]]
|
|
werte = items[sprintf("%02d", idx)]
|
|
summe = sum(werte, na.rm = TRUE)
|
|
n_ok = sum(!is.na(werte))
|
|
skalenwert = if (n_ok > 0) summe / n_ok else NA_real_
|
|
twert = lookup_twert(summe, normtabellen[[sk]], norm_spalten_name)
|
|
ergebnis[[paste0("summe_", sk)]] = summe
|
|
ergebnis[[paste0("n_items_", sk)]] = n_ok
|
|
ergebnis[[paste0("skwert_", sk)]] = skalenwert
|
|
ergebnis[[paste0("twert_", sk)]] = twert
|
|
}
|
|
|
|
gs = sum(items, na.rm = TRUE)
|
|
missing_items = sum(is.na(items))
|
|
gsi = if ((90 - missing_items) > 0) gs / (90 - missing_items) else NA_real_
|
|
pst = sum(items > 0, na.rm = TRUE)
|
|
psdi = if (pst > 0) gs / pst else NA_real_
|
|
|
|
ergebnis$GS = gs
|
|
ergebnis$missing_items = missing_items
|
|
ergebnis$GSI = gsi
|
|
ergebnis$PST = pst
|
|
ergebnis$PSDI = psdi
|
|
|
|
ergebnis$T_GSI = lookup_twert(gs, normtabellen$GSI, norm_spalten_name)
|
|
ergebnis$T_PST = lookup_twert(pst, normtabellen$PST, norm_spalten_name)
|
|
ergebnis$T_PSDI = lookup_twert(psdi, normtabellen$PSDI, norm_spalten_name)
|
|
|
|
ergebnis
|
|
}
|
|
|
|
lade_normtabellen = function() {
|
|
tabs = list()
|
|
for (nm in names(norm_dateinamen)) {
|
|
pfad = file.path(norm_dir, norm_dateinamen[[nm]])
|
|
if (file.exists(pfad)) {
|
|
tabs[[nm]] = read.csv(pfad, stringsAsFactors = FALSE)
|
|
}
|
|
}
|
|
tabs
|
|
}
|
|
|
|
twert_anzeige = function(t) {
|
|
if (is.na(t)) return(tags$span(class = "na-hinweis", "nicht normiert"))
|
|
tags$strong(round(t))
|
|
}
|
|
|
|
twert_zone = function(t) {
|
|
if (is.na(t)) return("")
|
|
if (t < 60) "unauffällig (T < 60)"
|
|
else if (t <= 70) "erhöht (T 60-70)"
|
|
else "deutlich erhöht (T > 70)"
|
|
}
|
|
|
|
skwert_fmt = function(x) if (is.na(x)) "-" else sprintf("%.2f", x)
|
|
|
|
gauge_plot = function(t_wert, akzent) {
|
|
df_zonen = data.frame(
|
|
xmin = c(20, 60, 70),
|
|
xmax = c(60, 70, 90),
|
|
farbe = c("#d4edda", "#fff3cd", "#f8d7da"),
|
|
label = c("unauffällig", "erhöht", "deutlich erhöht")
|
|
)
|
|
p = ggplot() +
|
|
geom_rect(data = df_zonen,
|
|
aes(xmin = xmin, xmax = xmax, ymin = 0, ymax = 1, fill = farbe),
|
|
color = "white", linewidth = 0.3) +
|
|
scale_fill_identity() +
|
|
geom_text(data = df_zonen,
|
|
aes(x = (xmin + xmax) / 2, y = 0.5, label = label),
|
|
size = 3, color = "#555") +
|
|
scale_x_continuous(limits = c(20, 90), breaks = c(20, 30, 40, 50, 60, 70, 80, 90)) +
|
|
scale_y_continuous(limits = c(0, 1.4)) +
|
|
theme_void() +
|
|
theme(axis.text.x = element_text(size = 9, color = "#555"),
|
|
axis.ticks.x = element_line(color = "#aaa"),
|
|
axis.ticks.length = unit(3, "pt"),
|
|
panel.grid = element_blank()) +
|
|
labs(x = "T-Wert", y = NULL)
|
|
|
|
if (!is.na(t_wert)) {
|
|
t_clip = max(20, min(90, as.numeric(t_wert)))
|
|
p = p +
|
|
geom_segment(aes(x = t_clip, xend = t_clip, y = 0, yend = 1.2),
|
|
color = akzent, linewidth = 1.5) +
|
|
geom_point(aes(x = t_clip, y = 1.2), color = akzent, size = 4, shape = 25, fill = akzent) +
|
|
geom_text(aes(x = t_clip, y = 1.35, label = paste0("T = ", round(t_clip))),
|
|
color = akzent, size = 3.5, fontface = "bold")
|
|
}
|
|
p
|
|
}
|
|
|
|
profil_plot = function(auswertung, akzent) {
|
|
skalen_reihenfolge = c("Somatisierung", "Zwanghaftigkeit", "Unsicherheit",
|
|
"Depressivitaet", "Aengstlichkeit", "Aggressivitaet",
|
|
"Phobie", "Paranoia", "Psychotizismus", "GSI")
|
|
kurz_labels = c("Soma", "Zwang", "Unsich.", "Depr.", "Angst",
|
|
"Aggr.", "Phobie", "Paranoia", "Psychot.", "GSI")
|
|
|
|
t_werte = c(
|
|
sapply(skalen_reihenfolge[-10], function(sk) {
|
|
v = auswertung[[paste0("twert_", sk)]]
|
|
if (is.null(v)) NA_real_ else as.numeric(v)
|
|
}),
|
|
as.numeric(auswertung$T_GSI)
|
|
)
|
|
|
|
df = data.frame(
|
|
skala = factor(kurz_labels, levels = kurz_labels),
|
|
t_wert = t_werte,
|
|
stringsAsFactors = FALSE
|
|
)
|
|
df_ok = df[!is.na(df$t_wert), ]
|
|
|
|
p = ggplot(df, aes(x = skala, y = t_wert, group = 1)) +
|
|
annotate("rect", xmin = -Inf, xmax = Inf, ymin = 40, ymax = 60,
|
|
fill = "#00aa44", alpha = 0.15) +
|
|
geom_hline(yintercept = 40, linetype = "dashed", color = "#bbb", linewidth = 0.6) +
|
|
geom_hline(yintercept = 60, linetype = "dashed", color = "#aaa", linewidth = 0.6) +
|
|
geom_hline(yintercept = 70, linetype = "dashed", color = "#888", linewidth = 0.6) +
|
|
annotate("text", x = 10.4, y = 40, label = "T=40", size = 2.8, color = "#999",
|
|
hjust = 0, vjust = -0.3) +
|
|
annotate("text", x = 10.4, y = 60, label = "T=60", size = 2.8, color = "#888",
|
|
hjust = 0, vjust = -0.3) +
|
|
annotate("text", x = 10.4, y = 70, label = "T=70", size = 2.8, color = "#666",
|
|
hjust = 0, vjust = -0.3) +
|
|
scale_y_continuous(limits = c(20, 90), breaks = seq(20, 90, 10)) +
|
|
scale_x_discrete(drop = FALSE) +
|
|
coord_cartesian(clip = "off") +
|
|
theme_minimal(base_size = 11) +
|
|
theme(axis.text.x = element_text(angle = 35, hjust = 1, size = 9),
|
|
panel.grid.minor = element_blank(),
|
|
panel.grid.major.x = element_blank(),
|
|
plot.margin = margin(5, 55, 5, 5)) +
|
|
labs(x = NULL, y = "T-Wert",
|
|
caption = "T=40 / T=60 / T=70 sind heuristische Schwellen, keine klinischen Grenzwerte.")
|
|
|
|
if (nrow(df_ok) >= 2) {
|
|
p = p + geom_line(data = df_ok, color = akzent, linewidth = 0.9)
|
|
}
|
|
p = p + geom_point(data = df_ok, color = akzent, size = 3.5)
|
|
p
|
|
}
|
|
|
|
badge_html = function(stufe) {
|
|
s = as.character(stufe)
|
|
tags$span(class = paste0("stufe-badge stufe-badge-", s), s)
|
|
}
|
|
|
|
skala_items_html = function(item_nummern, items) {
|
|
tagList(lapply(item_nummern, function(i) {
|
|
nr = sprintf("%02d", i)
|
|
rw = items[[nr]]
|
|
rw_s = if (is.null(rw) || is.na(rw)) NA_integer_ else as.integer(rw)
|
|
st = if (is.na(rw_s)) "-" else stufen_texte[[as.character(rw_s)]]
|
|
div(class = "item-zeile",
|
|
tags$span(class = "item-nr", nr),
|
|
tags$span(class = "item-text", scl90_itemtexte[[nr]]),
|
|
tags$span(class = "item-stufentext", st),
|
|
if (!is.na(rw_s)) badge_html(rw_s) else tags$span(class = "na-hinweis", "?")
|
|
)
|
|
}))
|
|
}
|
|
|
|
|
|
# Datenaufbereitung ####
|
|
|
|
scl90_itemtexte = c(
|
|
"01" = "Kopfschmerzen",
|
|
"02" = "Nervositat oder innerem Zittern",
|
|
"03" = "Immer wieder auftauchenden unangenehmen Gedanken, Worten oder Ideen, die Ihnen nicht aus dem Kopf gehen.",
|
|
"04" = "Ohnmachts- und Schwindelgefuhle",
|
|
"05" = "Verminderung Ihres Interesses oder Ihrer Freude an Sexualitat",
|
|
"06" = "allzu kritischer Einstellung gegenuber anderen",
|
|
"07" = "der Idee, dass irgend jemand Macht uber Ihre Gedanken hat",
|
|
"08" = "dem Gefuhl, dass andere an den meisten Ihrer Schwierigkeiten Schuld sind",
|
|
"09" = "Gedachtnisschwierigkeiten",
|
|
"10" = "Beunruhigung wegen Achtlosigkeit und Nachlassigkeit",
|
|
"11" = "dem Gefuhl, leicht reizbar oder verargerbar zu sein",
|
|
"12" = "Herz- und Brustschmerzen",
|
|
"13" = "Furcht auf offenen Platzen oder Strassen",
|
|
"14" = "Energielosigkeit oder Verlangsamung in den Bewegungen oder im Denken",
|
|
"15" = "Gedanken, sich das Leben zu nehmen",
|
|
"16" = "Horen von Stimmen, die sonst keiner hort",
|
|
"17" = "Zittern",
|
|
"18" = "dem Gefuhl, dass man den meisten Menschen nicht trauen kann",
|
|
"19" = "schlechtem Appetit",
|
|
"20" = "Neigung zum Weinen",
|
|
"21" = "Schuchternheit oder Unbeholfenheit im Umgang mit dem anderen Geschlecht",
|
|
"22" = "der Befurchtung, ertappt oder erwischt zu werden",
|
|
"23" = "plotzlichem Erschrecken ohne Grund",
|
|
"24" = "Gefuhlsausbruchen, denen gegenuber Sie machtlos waren",
|
|
"25" = "Befurchtungen, wenn Sie alleine aus dem Haus gehen",
|
|
"26" = "Selbstvorwurfen uber bestimmten Dingen",
|
|
"27" = "Kreuzschmerzen",
|
|
"28" = "dem Gefuhl, dass es Ihnen schwer fallt etwas anzufangen",
|
|
"29" = "Einsamkeitsgefuhlen",
|
|
"30" = "Schwermut",
|
|
"31" = "dem Gefuhl, sich zu viele Sorgen machen zu mussen",
|
|
"32" = "dem Gefuhl, sich fur nichts zu interessieren",
|
|
"33" = "Furchtsamkeit",
|
|
"34" = "Verletzlichkeit in Gefuhlsdingen",
|
|
"35" = "der Idee, dass andere Leute von Ihren geheimsten Gedanken wissen",
|
|
"36" = "dem Gefuhl, dass andere Sie nicht verstehen oder teilnahmslos sind",
|
|
"37" = "dem Gefuhl, dass die Leute unfreundlich sind oder Sie nicht leiden konnen",
|
|
"38" = "die Notwendigkeit, alles sehr langsam zu tun, um sicher zu sein, dass alles richtig wird",
|
|
"39" = "Herzklopfen oder Herzjagen",
|
|
"40" = "Ubelkeit oder Magenverstimmung",
|
|
"41" = "Minderwertigkeitsgefuhlen gegenuber anderen",
|
|
"42" = "Muskelschmerzen (Muskelkater, Gliederreissen)",
|
|
"43" = "dem Gefuhl, dass andere Sie beobachten oder uber Sie reden",
|
|
"44" = "Einschlafschwierigkeiten",
|
|
"45" = "dem Zwang, wieder und wieder nachzukontrollieren, was sie tun",
|
|
"46" = "Schwierigkeiten, sich zu entscheiden",
|
|
"47" = "Furcht vor Fahrten in Bus, Strassenbahn, U-Bahn oder Zug",
|
|
"48" = "Schwierigkeiten beim Atmen",
|
|
"49" = "Hitzewallungen oder Kalteschauern",
|
|
"50" = "der Notwendigkeit, bestimmte Dinge, Orte oder Tatigkeiten zu meiden, weil Sie durch diese erschreckt werden",
|
|
"51" = "Leere im Kopf",
|
|
"52" = "Taubheit oder Kribbeln in einzelnen Korperteilen",
|
|
"53" = "dem Gefuhl, einen Klumpen (Kloss) im Hals zu haben",
|
|
"54" = "einem Gefuhl der Hoffnungslosigkeit angesichts der Zukunft",
|
|
"55" = "Konzentrationsschwierigkeiten",
|
|
"56" = "Schwachegefuhlen in einzelnen Korperteilen",
|
|
"57" = "dem Gefuhl, gespannt oder aufgeregt zu sein",
|
|
"58" = "Schweregefuhl in Armen oder Beinen",
|
|
"59" = "Gedanken an den Tod oder ans Sterben",
|
|
"60" = "dem Drang, sich zu uberessen",
|
|
"61" = "einem unbehaglichen Gefuhl, wenn Leute Sie beobachten oder uber Sie reden",
|
|
"62" = "dem Auftauchen von Gedanken, die nicht Ihre eigenen sind",
|
|
"63" = "dem Drang, jemanden zu schlagen, zu verletzen oder ihm Schmerz zuzufugen",
|
|
"64" = "fruhem Erwachen am Morgen",
|
|
"65" = "zwanghafter Wiederholung derselben Tatigkeiten wie Beruhren, Zahlen, Waschen",
|
|
"66" = "unruhigem oder gestortem Schlaf",
|
|
"67" = "den Drang, Dinge zu zerbrechen oder zu zerschmettern",
|
|
"68" = "Ideen oder Anschauungen, die andere nicht mit Ihnen teilen",
|
|
"69" = "starker Befangenheit im Umgang mit anderen",
|
|
"70" = "Abneigung gegen Menschenmengen, z. B. beim Einkaufen oder im Kino",
|
|
"71" = "einem Gefuhl, dass alles sehr anstrengend wird",
|
|
"72" = "Schreck- oder Panikanfallen",
|
|
"73" = "Unbehagen beim Essen oder Trinken in der Offentlichkeit",
|
|
"74" = "der Neigung, immer wieder in Erorterungen und Auseinandersetzungen zu geraten",
|
|
"75" = "Nervositat, wenn Sie allein gelassen werden",
|
|
"76" = "mangelnder Anerkennung Ihrer Leistungen durch andere",
|
|
"77" = "Einsamkeitsgefuhlen, selbst wenn Sie in Gesellschaft sind",
|
|
"78" = "so starker Ruhelosigkeit, dass Sie nicht stillsitzen konnen",
|
|
"79" = "dem Gefuhl, wertlos zu sein",
|
|
"80" = "dem Gefuhl, dass etwas Schlimmes passieren wird",
|
|
"81" = "dem Bedurfnis laut zu schreien oder mit Gegenstanden zu werfen",
|
|
"82" = "der Furcht, in der Offentlichkeit in Ohnmacht zu fallen",
|
|
"83" = "dem Gefuhl, dass die Leute Sie ausnutzen, wenn Sie es zulassen wurden",
|
|
"84" = "sexuelle Vorstellungen, die ziemlich unangenehm fur Sie sind",
|
|
"85" = "dem Gedanken, dass Sie fur Ihre Sunden bestraft werden sollten",
|
|
"86" = "schreckenerregenden Gedanken und Vorstellungen",
|
|
"87" = "dem Gedanken, dass etwas ernstlich mit Ihrem Korper nicht in Ordnung ist",
|
|
"88" = "dem Eindruck, sich einer anderen Person nie so richtig nahe fuhlen zu konnen",
|
|
"89" = "Schuldgefuhlen",
|
|
"90" = "dem Gedanken, dass irgendetwas mit Ihrem Verstand nicht in Ordnung ist"
|
|
)
|
|
|
|
subskalen = list(
|
|
Somatisierung = c(1, 4, 12, 27, 40, 42, 48, 49, 52, 53, 56, 58),
|
|
Zwanghaftigkeit = c(3, 9, 10, 28, 38, 45, 46, 51, 55, 65),
|
|
Unsicherheit = c(6, 21, 34, 36, 37, 41, 61, 69, 73),
|
|
Depressivitaet = c(5, 14, 15, 20, 22, 26, 29, 30, 31, 32, 54, 71, 79),
|
|
Aengstlichkeit = c(2, 17, 23, 33, 39, 57, 72, 78, 80, 86),
|
|
Aggressivitaet = c(11, 24, 63, 67, 74, 81),
|
|
Phobie = c(13, 25, 47, 50, 70, 75, 82),
|
|
Paranoia = c(8, 18, 43, 68, 76, 83),
|
|
Psychotizismus = c(7, 16, 35, 62, 77, 84, 85, 87, 88, 90),
|
|
Zusatzitems = c(19, 44, 59, 60, 64, 66, 89)
|
|
)
|
|
|
|
subskalen_namen_lang = c(
|
|
Somatisierung = "Somatisierung",
|
|
Zwanghaftigkeit = "Zwanghaftigkeit",
|
|
Unsicherheit = "Unsicherheit im Sozialkontakt",
|
|
Depressivitaet = "Depressivitat",
|
|
Aengstlichkeit = "Angstlichkeit",
|
|
Aggressivitaet = "Aggressivitat/Feindseligkeit",
|
|
Phobie = "Phobische Angst",
|
|
Paranoia = "Paranoides Denken",
|
|
Psychotizismus = "Psychotizismus"
|
|
)
|
|
|
|
norm_dateinamen = c(
|
|
Somatisierung = "norm_somatisierung.csv",
|
|
Zwanghaftigkeit = "norm_zwanghaftigkeit.csv",
|
|
Unsicherheit = "norm_unsicherheit.csv",
|
|
Depressivitaet = "norm_depressivitaet.csv",
|
|
Aengstlichkeit = "norm_aengstlichkeit.csv",
|
|
Aggressivitaet = "norm_aggressivitaet.csv",
|
|
Phobie = "norm_phobie.csv",
|
|
Paranoia = "norm_paranoia.csv",
|
|
Psychotizismus = "norm_psychotizismus.csv",
|
|
GSI = "norm_gsi.csv",
|
|
PST = "norm_pst.csv",
|
|
PSDI = "norm_psdi.csv"
|
|
)
|
|
|
|
stufen_texte = c("0" = "uberhaupt nicht", "1" = "ein wenig", "2" = "ziemlich",
|
|
"3" = "stark", "4" = "sehr stark")
|
|
|
|
normtabellen = lade_normtabellen()
|
|
|
|
|
|
# UI ####
|
|
|
|
app_css = "
|
|
body { font-family: 'Segoe UI', Helvetica, Arial, sans-serif; background: #f5f5f5;
|
|
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: 20px;
|
|
margin-bottom: 18px;
|
|
box-shadow: 0 1px 4px rgba(0,0,0,0.10);
|
|
}
|
|
.abschnitt-titel {
|
|
color: #8B2635;
|
|
margin-top: 0;
|
|
margin-bottom: 12px;
|
|
font-size: 1em;
|
|
font-weight: 700;
|
|
}
|
|
|
|
.alert-warnung {
|
|
background: #fff8dc;
|
|
border-left: 4px solid #e6a817;
|
|
padding: 10px 14px;
|
|
border-radius: 4px;
|
|
margin-bottom: 12px;
|
|
font-size: 0.9em;
|
|
}
|
|
|
|
.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 { color: #444; font-size: 0.92em; }
|
|
|
|
.kritisch-block {
|
|
background: #fff0f0;
|
|
border-left: 5px solid #cc0000;
|
|
border-radius: 4px;
|
|
padding: 14px 18px;
|
|
margin-bottom: 12px;
|
|
}
|
|
.kritisch-block h4 { color: #cc0000; margin-top: 0; }
|
|
|
|
.disclaimer { font-size: 0.82em; color: #888; margin-top: 6px; font-style: italic; }
|
|
|
|
.kw-tabelle td, .kw-tabelle th { padding: 6px 12px; border-bottom: 1px solid #eee; }
|
|
.kw-tabelle th { background: #f0f0f0; font-weight: 600; }
|
|
.kw-tabelle { width: 100%; border-collapse: collapse; }
|
|
|
|
.stufe-badge {
|
|
display: inline-block;
|
|
padding: 2px 8px;
|
|
border-radius: 10px;
|
|
font-weight: 600;
|
|
font-size: 0.85em;
|
|
min-width: 22px;
|
|
text-align: center;
|
|
}
|
|
.stufe-badge-0 { background: #d4edda; color: #155724; }
|
|
.stufe-badge-1 { background: #ffe0e6; color: #7a2030; }
|
|
.stufe-badge-2 { background: #f08080; color: #fff; }
|
|
.stufe-badge-3 { background: #cc0000; color: #fff; }
|
|
.stufe-badge-4 { background: #7a0000; color: #fff; }
|
|
|
|
.item-zeile {
|
|
display: flex;
|
|
align-items: flex-start;
|
|
gap: 10px;
|
|
padding: 5px 0;
|
|
border-bottom: 1px solid #f0f0f0;
|
|
font-size: 0.9em;
|
|
}
|
|
.item-nr { min-width: 28px; color: #888; font-weight: 600; }
|
|
.item-text { flex: 1; }
|
|
.item-stufentext { color: #666; font-size: 0.88em; min-width: 100px; }
|
|
|
|
.na-hinweis { color: #999; font-style: italic; }
|
|
"
|
|
|
|
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("SCL-90-R Auswertung"),
|
|
tags$p("Symptom-Checkliste-90-R • Einzelfall-Auswertung")
|
|
),
|
|
|
|
div(style = "max-width: 1600px; margin: auto; padding: 0 16px;",
|
|
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_docx", "Word-Export (.docx)")
|
|
)
|
|
),
|
|
|
|
uiOutput("warnung_ui"),
|
|
uiOutput("kritisch_ui"),
|
|
uiOutput("global_ui"),
|
|
uiOutput("profil_ui"),
|
|
uiOutput("subskalen_items_ui")
|
|
)
|
|
)
|
|
|
|
|
|
# Word-Export ####
|
|
|
|
erstelle_scl90r_docx = function(chiffre, datum_str, auswertung, norm_spalten_name) {
|
|
grau_fp = fp_text(color = "#555555", font.size = 11)
|
|
rot_fp = fp_text(color = "#CC0000", bold = TRUE, font.size = 11)
|
|
normal_fp = fp_text(font.size = 11)
|
|
klein_fp = fp_text(font.size = 9, color = "#666666", italic = TRUE)
|
|
|
|
stufen_farben = c("0" = "#d4edda", "1" = "#ffe0e6", "2" = "#f08080",
|
|
"3" = "#cc0000", "4" = "#7a0000")
|
|
stufen_text_farben = c("0" = "#155724", "1" = "#7a2030", "2" = "#ffffff",
|
|
"3" = "#ffffff", "4" = "#ffffff")
|
|
|
|
doc = read_docx()
|
|
|
|
doc = body_add_fpar(doc, fpar(
|
|
ftext("SCL-90-R Auswertung", fp_text(color = AKZENT_FARBE, bold = TRUE, font.size = 18))
|
|
))
|
|
doc = body_add_fpar(doc, fpar(
|
|
ftext(paste0("Chiffre: ", chiffre, " | Ausfuelldatum: ", datum_str,
|
|
" | Erstellt: ", format(Sys.Date(), "%d.%m.%Y")), grau_fp)
|
|
))
|
|
doc = body_add_par(doc, "", style = "Normal")
|
|
|
|
doc = body_add_fpar(doc, fpar(
|
|
ftext("Globalkennwerte", fp_text(bold = TRUE, font.size = 13))
|
|
))
|
|
|
|
gsi_t = if (is.na(auswertung$T_GSI)) "nicht normiert" else as.character(round(auswertung$T_GSI))
|
|
pst_t = if (is.na(auswertung$T_PST)) "nicht normiert" else as.character(round(auswertung$T_PST))
|
|
psdi_t = if (is.na(auswertung$T_PSDI)) "nicht normiert" else as.character(round(auswertung$T_PSDI))
|
|
|
|
for (zeile in list(
|
|
c("GSI", skwert_fmt(auswertung$GSI), gsi_t),
|
|
c("PST", as.character(auswertung$PST), pst_t),
|
|
c("PSDI", skwert_fmt(auswertung$PSDI), psdi_t)
|
|
)) {
|
|
doc = body_add_fpar(doc, fpar(
|
|
ftext(sprintf("%-6s Wert: %-8s T-Wert: %s", zeile[1], zeile[2], zeile[3]), normal_fp)
|
|
))
|
|
}
|
|
|
|
doc = body_add_par(doc, "", style = "Normal")
|
|
|
|
# rvg zeichnet das Profildiagramm als DrawingML-Vektorgrafik in Word
|
|
doc = body_add_gg(doc, value = profil_plot(auswertung, AKZENT_FARBE),
|
|
width = 6, height = 3)
|
|
doc = body_add_par(doc, "", style = "Normal")
|
|
|
|
doc = body_add_fpar(doc, fpar(
|
|
ftext("Subskalen", fp_text(bold = TRUE, font.size = 12))
|
|
))
|
|
skalen9 = c("Somatisierung", "Zwanghaftigkeit", "Unsicherheit", "Depressivitaet",
|
|
"Aengstlichkeit", "Aggressivitaet", "Phobie", "Paranoia", "Psychotizismus")
|
|
for (sk in skalen9) {
|
|
sw = skwert_fmt(auswertung[[paste0("skwert_", sk)]])
|
|
tv = auswertung[[paste0("twert_", sk)]]
|
|
tv_s = if (is.null(tv) || is.na(tv)) "nicht normiert" else as.character(round(tv))
|
|
doc = body_add_fpar(doc, fpar(
|
|
ftext(sprintf("%-38s MW: %-6s T: %s", subskalen_namen_lang[[sk]], sw, tv_s), grau_fp)
|
|
))
|
|
}
|
|
|
|
doc = body_add_par(doc, "", style = "Normal")
|
|
|
|
kritisch_items = list(
|
|
list(nr = "15", text = scl90_itemtexte[["15"]]),
|
|
list(nr = "59", text = scl90_itemtexte[["59"]])
|
|
)
|
|
hat_kritisch = FALSE
|
|
for (ki in kritisch_items) {
|
|
rw = auswertung$items[[ki$nr]]
|
|
if (!is.na(rw) && rw >= 1) {
|
|
if (!hat_kritisch) {
|
|
doc = body_add_fpar(doc, fpar(
|
|
ftext("Kritische Items", fp_text(color = "#CC0000", bold = TRUE, font.size = 12))
|
|
))
|
|
hat_kritisch = TRUE
|
|
}
|
|
st = stufen_texte[[as.character(as.integer(rw))]]
|
|
doc = body_add_fpar(doc, fpar(ftext(paste0("Item ", ki$nr, ": ", ki$text), rot_fp)))
|
|
doc = body_add_fpar(doc, fpar(ftext(paste0("Antwort: ", as.integer(rw), " - ", st), normal_fp)))
|
|
doc = body_add_fpar(doc, fpar(ftext("Kein automatisiertes klinisches Urteil.", klein_fp)))
|
|
doc = body_add_par(doc, "", style = "Normal")
|
|
}
|
|
}
|
|
|
|
doc = body_add_par(doc, "", style = "Normal")
|
|
doc = body_add_fpar(doc, fpar(
|
|
ftext("Items nach Subskala", fp_text(bold = TRUE, font.size = 12))
|
|
))
|
|
|
|
alle_abschnitte = c(setdiff(names(subskalen), "Zusatzitems"), "Zusatzitems")
|
|
|
|
for (sk in alle_abschnitte) {
|
|
sk_label = if (sk == "Zusatzitems") "Zusatzitems" else subskalen_namen_lang[[sk]]
|
|
doc = body_add_fpar(doc, fpar(
|
|
ftext(sk_label, fp_text(bold = TRUE, font.size = 10, color = AKZENT_FARBE))
|
|
))
|
|
for (i in subskalen[[sk]]) {
|
|
nr = sprintf("%02d", i)
|
|
rw = auswertung$items[[nr]]
|
|
rw_s = if (is.null(rw) || is.na(rw)) NA_integer_ else as.integer(rw)
|
|
st = if (is.na(rw_s)) "?" else stufen_texte[[as.character(rw_s)]]
|
|
rw_str = if (is.na(rw_s)) "?" else as.character(rw_s)
|
|
bg_col = if (!is.na(rw_s)) stufen_farben[[rw_str]] else "#eeeeee"
|
|
tx_col = if (!is.na(rw_s)) stufen_text_farben[[rw_str]] else "#555555"
|
|
doc = body_add_fpar(doc, fpar(
|
|
ftext(nr, fp_text(font.size = 9, color = "#888888")),
|
|
ftext(" ", fp_text(font.size = 9)),
|
|
ftext(scl90_itemtexte[[nr]], fp_text(font.size = 9)),
|
|
ftext(paste0(" [", rw_str, " - ", st, "]"),
|
|
fp_text(font.size = 9, color = tx_col, shading.color = bg_col))
|
|
))
|
|
}
|
|
doc = body_add_par(doc, "", style = "Normal")
|
|
}
|
|
|
|
doc = body_add_par(doc, "", style = "Normal")
|
|
doc = body_add_fpar(doc, fpar(ftext(SCL90R_DISCLAIMER, klein_fp)))
|
|
|
|
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)))
|
|
}
|
|
})
|
|
|
|
auswertungs_daten = eventReactive(input$btn_suchen, {
|
|
|
|
chiffre = toupper(trimws(input$chiffre))
|
|
|
|
if ((nchar(trimws(input$pseudonym)) == 0 && nchar(chiffre) == 0)) {
|
|
return(list(fehler = "Bitte eine Chiffre eingeben."))
|
|
}
|
|
if (!(nchar(trimws(input$pseudonym)) > 0 || grepl("^[A-Z][0-9]{6}$", chiffre))) {
|
|
return(list(fehler = paste0(
|
|
"Ungueltige Chiffre. Erwartet wird ein Grossbuchstabe gefolgt von 6 Ziffern, ",
|
|
"z.B. P000123.")))
|
|
}
|
|
if (!file.exists(PFAD_DOWNLOAD_SKRIPT)) {
|
|
return(list(fehler = paste0("Download-Skript nicht gefunden:\n", PFAD_DOWNLOAD_SKRIPT)))
|
|
}
|
|
if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) {
|
|
return(list(fehler = paste0("Pseudonym-Skript nicht gefunden:\n", PFAD_PSEUDONYM_SKRIPT)))
|
|
}
|
|
|
|
tryCatch(
|
|
source(PFAD_DOWNLOAD_SKRIPT, local = FALSE),
|
|
error = function(e) stop(paste0("Fehler im Download-Skript: ", conditionMessage(e)))
|
|
)
|
|
|
|
if (!exists("daten_scl90r", envir = .GlobalEnv)) {
|
|
return(list(fehler = "Variable 'daten_scl90r' wurde vom Download-Skript nicht bereitgestellt."))
|
|
}
|
|
|
|
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(fehler = "Datei 'pseudonyme.db' wurde nicht gefunden (bis 5 Ebenen aufwaerts gesucht)."))
|
|
}
|
|
|
|
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(fehler = paste0("Fehler im Pseudonym-Skript: ", conditionMessage(e)))
|
|
})
|
|
if (is.list(ok_ps)) return(ok_ps)
|
|
|
|
if (!exists("pseudo", envir = .GlobalEnv)) {
|
|
return(list(fehler = "Variable 'pseudo' wurde vom Pseudonym-Skript nicht bereitgestellt."))
|
|
}
|
|
|
|
dat_ps = get("pseudo", envir = .GlobalEnv)
|
|
daten_scl90r = get("daten_scl90r", envir = .GlobalEnv)
|
|
|
|
# tolower()-Vergleich ist intentional: Chiffren in pseudonyme.db koennen gemischte
|
|
# Gross-/Kleinschreibung haben; toupper() auf Input-Seite allein reicht nicht aus.
|
|
treffer_pseudo = dat_ps[tolower(trimws(dat_ps$chiffre)) == tolower(chiffre), ]
|
|
if (nrow(treffer_pseudo) == 0) {
|
|
return(list(fehler = "Chiffre nicht gefunden."))
|
|
}
|
|
|
|
alle_session_ids = unique(treffer_pseudo$pseudonym)
|
|
if (nchar(trimws(input$pseudonym)) > 0) alle_session_ids = trimws(input$pseudonym)
|
|
|
|
treffer_daten = daten_scl90r[daten_scl90r$session %in% alle_session_ids, ]
|
|
if (nrow(treffer_daten) == 0) {
|
|
return(list(fehler = paste0(
|
|
"Keine SCL-90-R-Daten gefunden. (",
|
|
length(alle_session_ids), " Pseudonym(e) geprueft)")))
|
|
}
|
|
|
|
warnung = NULL
|
|
if (nrow(treffer_daten) > 1) {
|
|
if ("created" %in% names(treffer_daten)) {
|
|
created_vals = as.POSIXct(treffer_daten$created, tz = "UTC")
|
|
neueste_idx = which.max(created_vals)
|
|
datum_s = format(created_vals[neueste_idx], "%d.%m.%Y %H:%M")
|
|
warnung = paste0("Mehrere Eintraege gefunden. Zeige den neuesten vom ", datum_s, ".")
|
|
treffer_daten = treffer_daten[neueste_idx, , drop = FALSE]
|
|
} else {
|
|
warnung = "Mehrere Eintraege gefunden. Zeige den ersten Eintrag."
|
|
treffer_daten = treffer_daten[1, , drop = FALSE]
|
|
}
|
|
}
|
|
|
|
zeile = as.list(treffer_daten[1, ])
|
|
|
|
g_val = if ("scl90_geschlecht" %in% names(zeile)) zeile$scl90_geschlecht else NA
|
|
b_val = if ("scl90_bildung" %in% names(zeile)) zeile$scl90_bildung else NA
|
|
g_labels = attr(treffer_daten$scl90_geschlecht, "labels")
|
|
b_labels = attr(treffer_daten$scl90_bildung, "labels")
|
|
ns_name = norm_spalte(g_val, g_labels, b_val, b_labels)
|
|
|
|
ergebnis = berechne_auswertung(zeile, ns_name)
|
|
datum_anzeige = if ("created" %in% names(zeile) && !is.na(zeile$created)) {
|
|
format(as.POSIXct(zeile$created, tz = "UTC"), "%d.%m.%Y")
|
|
} else format(Sys.Date(), "%d.%m.%Y")
|
|
|
|
list(
|
|
ok = TRUE,
|
|
auswertung = ergebnis,
|
|
chiffre = chiffre,
|
|
datum_str = datum_anzeige,
|
|
ns_name = ns_name,
|
|
warnung = warnung
|
|
)
|
|
})
|
|
|
|
|
|
output$warnung_ui = renderUI({
|
|
d = auswertungs_daten()
|
|
if (!is.null(d$fehler)) {
|
|
return(div(class = "alert-fehler",
|
|
tags$h4("Fehler"),
|
|
tags$p(d$fehler)))
|
|
}
|
|
if (!is.null(d$warnung)) {
|
|
div(class = "alert-warnung", d$warnung)
|
|
}
|
|
})
|
|
|
|
|
|
output$kritisch_ui = renderUI({
|
|
d = auswertungs_daten()
|
|
if (is.null(d$ok)) return(NULL)
|
|
aw = d$auswertung
|
|
ki_liste = list(
|
|
list(nr = "15", text = scl90_itemtexte[["15"]]),
|
|
list(nr = "59", text = scl90_itemtexte[["59"]])
|
|
)
|
|
bloecke = lapply(ki_liste, function(ki) {
|
|
rw = aw$items[[ki$nr]]
|
|
if (!is.na(rw) && rw >= 1) {
|
|
st = stufen_texte[[as.character(as.integer(rw))]]
|
|
div(class = "kritisch-block",
|
|
tags$h4(paste0("Item ", ki$nr, ": ", ki$text)),
|
|
tags$p(paste0("Antwort: ", as.integer(rw), " - ", st)),
|
|
tags$p(class = "disclaimer", "Kein automatisiertes klinisches Urteil.")
|
|
)
|
|
}
|
|
})
|
|
bloecke = Filter(Negate(is.null), bloecke)
|
|
if (length(bloecke) > 0) div(class = "abschnitt-karte", do.call(tagList, bloecke))
|
|
})
|
|
|
|
|
|
output$global_ui = renderUI({
|
|
d = auswertungs_daten()
|
|
if (is.null(d$ok)) return(NULL)
|
|
aw = d$auswertung
|
|
|
|
psdi_hinweis = if (is.na(aw$PSDI) && aw$PST == 0) {
|
|
tags$p(class = "na-hinweis", "PSDI: nicht berechenbar (PST = 0, keine belasteten Items).")
|
|
} else NULL
|
|
|
|
tagList(
|
|
div(class = "abschnitt-karte",
|
|
tags$h4(class = "abschnitt-titel", "Globalkennwerte"),
|
|
tags$table(class = "kw-tabelle",
|
|
tags$thead(tags$tr(
|
|
tags$th("Kennwert"), tags$th("Wert"), tags$th("T-Wert"), tags$th("Einordnung")
|
|
)),
|
|
tags$tbody(
|
|
tags$tr(
|
|
tags$td("GSI (Global Severity Index)"),
|
|
tags$td(skwert_fmt(aw$GSI)),
|
|
tags$td(twert_anzeige(aw$T_GSI)),
|
|
tags$td(twert_zone(aw$T_GSI))
|
|
),
|
|
tags$tr(
|
|
tags$td("PST (Positive Symptom Total)"),
|
|
tags$td(aw$PST),
|
|
tags$td(twert_anzeige(aw$T_PST)),
|
|
tags$td(twert_zone(aw$T_PST))
|
|
),
|
|
tags$tr(
|
|
tags$td("PSDI (Positive Symptom Distress Index)"),
|
|
tags$td(skwert_fmt(aw$PSDI)),
|
|
tags$td(twert_anzeige(aw$T_PSDI)),
|
|
tags$td(twert_zone(aw$T_PSDI))
|
|
)
|
|
)
|
|
),
|
|
psdi_hinweis,
|
|
tags$p(class = "disclaimer",
|
|
paste0("Normierungsspalte: ", d$ns_name, ".")),
|
|
tags$hr(),
|
|
tags$h5("GSI T-Wert - Uberblick"),
|
|
plotOutput("gauge_plot", height = "90px")
|
|
)
|
|
)
|
|
})
|
|
|
|
output$gauge_plot = renderPlot({
|
|
d = auswertungs_daten()
|
|
if (is.null(d$ok)) return(NULL)
|
|
gauge_plot(d$auswertung$T_GSI, AKZENT_FARBE)
|
|
}, bg = "white")
|
|
|
|
|
|
output$profil_ui = renderUI({
|
|
d = auswertungs_daten()
|
|
if (is.null(d$ok)) return(NULL)
|
|
aw = d$auswertung
|
|
skalen9 = c("Somatisierung", "Zwanghaftigkeit", "Unsicherheit", "Depressivitaet",
|
|
"Aengstlichkeit", "Aggressivitaet", "Phobie", "Paranoia", "Psychotizismus")
|
|
zeilen = lapply(skalen9, function(sk) {
|
|
sw = skwert_fmt(aw[[paste0("skwert_", sk)]])
|
|
tv = aw[[paste0("twert_", sk)]]
|
|
tags$tr(
|
|
tags$td(subskalen_namen_lang[[sk]]),
|
|
tags$td(sw),
|
|
tags$td(twert_anzeige(tv)),
|
|
tags$td(twert_zone(tv))
|
|
)
|
|
})
|
|
|
|
div(class = "abschnitt-karte",
|
|
tags$h4(class = "abschnitt-titel", "Subskalen-Profil"),
|
|
plotOutput("profil_plot", height = "320px"),
|
|
tags$br(),
|
|
tags$table(class = "kw-tabelle",
|
|
tags$thead(tags$tr(
|
|
tags$th("Subskala"), tags$th("Mittelwert"), tags$th("T-Wert"), tags$th("Einordnung")
|
|
)),
|
|
tags$tbody(do.call(tagList, zeilen))
|
|
)
|
|
)
|
|
})
|
|
|
|
output$profil_plot = renderPlot({
|
|
d = auswertungs_daten()
|
|
if (is.null(d$ok)) return(NULL)
|
|
profil_plot(d$auswertung, AKZENT_FARBE)
|
|
}, bg = "white")
|
|
|
|
|
|
skalen9_liste = c("Somatisierung", "Zwanghaftigkeit", "Unsicherheit", "Depressivitaet",
|
|
"Aengstlichkeit", "Aggressivitaet", "Phobie", "Paranoia", "Psychotizismus")
|
|
|
|
output$subskalen_items_ui = renderUI({
|
|
d = auswertungs_daten()
|
|
if (is.null(d$ok)) return(NULL)
|
|
aw = d$auswertung
|
|
|
|
sk_panels = lapply(skalen9_liste, function(sk) {
|
|
tv = aw[[paste0("twert_", sk)]]
|
|
sw = skwert_fmt(aw[[paste0("skwert_", sk)]])
|
|
zone = twert_zone(tv)
|
|
gauge_id = paste0("gauge_sk_", sk)
|
|
div(class = "abschnitt-karte",
|
|
tags$h4(class = "abschnitt-titel", subskalen_namen_lang[[sk]]),
|
|
tags$p(
|
|
tags$strong(paste0("Mittelwert: ", sw, " | T-Wert: ")),
|
|
twert_anzeige(tv),
|
|
if (nchar(zone) > 0) tags$span(style = "color:#666; margin-left:8px;", paste0("(", zone, ")"))
|
|
),
|
|
plotOutput(gauge_id, height = "80px"),
|
|
tags$div(style = "margin-top:10px;",
|
|
skala_items_html(subskalen[[sk]], aw$items)
|
|
)
|
|
)
|
|
})
|
|
|
|
zusatz_panel = div(class = "abschnitt-karte",
|
|
tags$h4(class = "abschnitt-titel", "Zusatzitems"),
|
|
tags$p(style = "color:#888; font-size:0.88em;",
|
|
"Zusatzitems fliessen in GSI/PST/PSDI ein, bilden keine eigene Subskala."),
|
|
skala_items_html(subskalen[["Zusatzitems"]], aw$items)
|
|
)
|
|
|
|
do.call(tagList, c(sk_panels, list(zusatz_panel)))
|
|
})
|
|
|
|
observe({
|
|
d = auswertungs_daten()
|
|
if (is.null(d$ok)) return()
|
|
aw = d$auswertung
|
|
for (sk in skalen9_liste) {
|
|
local({
|
|
sk_ = sk
|
|
output[[paste0("gauge_sk_", sk_)]] = renderPlot({
|
|
gauge_plot(aw[[paste0("twert_", sk_)]], AKZENT_FARBE)
|
|
}, bg = "white")
|
|
})
|
|
}
|
|
})
|
|
|
|
|
|
output$download_docx = downloadHandler(
|
|
filename = function() {
|
|
d = auswertungs_daten()
|
|
if (is.null(d$ok)) return("SCL90R_Auswertung.docx")
|
|
ausfuelldatum_fn = format(as.Date(d$datum_str, "%d.%m.%Y"), "%Y%m%d")
|
|
paste0("SCL90R_", d$chiffre, "_", ausfuelldatum_fn, ".docx")
|
|
},
|
|
content = function(file) {
|
|
d = auswertungs_daten()
|
|
req(isTRUE(d$ok))
|
|
doc = erstelle_scl90r_docx(d$chiffre, d$datum_str, d$auswertung, d$ns_name)
|
|
print(doc, target = file)
|
|
}
|
|
)
|
|
}
|
|
|
|
|
|
# Start ####
|
|
|
|
shinyApp(ui = ui, server = server)
|