1064 lines
39 KiB
R
1064 lines
39 KiB
R
# Präambel ####
|
||
|
||
AKZENT_FARBE = "#8B2635"
|
||
|
||
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_csas_fp.R"
|
||
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"
|
||
|
||
CSAS_FP_ERGAENZUNGSHINWEIS = paste0(
|
||
"Die Fremdbeurteilung durch den Partner (CSAS-FP) ist laut Testmanual als Ergaenzung ",
|
||
"zum diagnostischen Urteil zu verstehen und sollte nur zusammen mit der Selbstbeurteilung ",
|
||
"(CSAS-E) der betroffenen Person eingesetzt werden, nicht als eigenstaendiges Diagnoseinstrument. ",
|
||
"Bei deutlicher Abweichung zwischen Selbst- und Fremdbericht sollten weiterfuehrende ",
|
||
"diagnostische Informationen eingeholt werden."
|
||
)
|
||
|
||
CSAS_FP_DISCLAIMER = paste0(
|
||
"Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
|
||
"keine klinische Diagnose. Die Interpretation obliegt der behandelnden Person. ",
|
||
"Der Cutoff von 5 erfuellten DSM-5-Kriterien ist laut Testmanual eine pragmatische, ",
|
||
"bewusst konservative Konvention und keine validierte diagnostische Schwelle. ",
|
||
"Diese Fremdbeurteilung ersetzt keine Selbstbeurteilung (CSAS-E)."
|
||
)
|
||
|
||
CSAS_FP_KEINE_NORMWERTE_HINWEIS = paste0(
|
||
"Fuer die Fremdbeurteilungsversion CSAS-FP liegen laut Testmanual keine Normwerte vor."
|
||
)
|
||
|
||
# Recoding-Tabelle der 18 Kernitems (Choice-Text nach Markdown-Bereinigung -> Wert 0-3).
|
||
CSAS_FP_CHOICE_TEXTE = c("stimmt nicht", "stimmt kaum", "stimmt eher", "stimmt genau")
|
||
|
||
# Fuer die Geraete-Matrix-Items ist nur relevant, ob Choice 1 ("nie") vorliegt.
|
||
CSAS_FP_GERAET_NIE_TEXT = c("nie")
|
||
|
||
CSAS_FP_GERAET_FELDER = c(
|
||
"csas_fp_geraet_pc", "csas_fp_geraet_konsole",
|
||
"csas_fp_geraet_tragbar", "csas_fp_geraet_handy"
|
||
)
|
||
CSAS_FP_GERAET_LABELS = c(
|
||
csas_fp_geraet_pc = "PC",
|
||
csas_fp_geraet_konsole = "Konsole",
|
||
csas_fp_geraet_tragbar = "Tragbares Geraet",
|
||
csas_fp_geraet_handy = "Handy/Smartphone"
|
||
)
|
||
|
||
# DSM-5-Kriterien: 9 Kriterien, je 2 zugehoerige Items (identische Zuordnung wie CSAS-E).
|
||
CSAS_FP_KRITERIEN = list(
|
||
list(name = "Gedankliche Vereinnahmung", items = c(1, 8)),
|
||
list(name = "Entzugserscheinungen", items = c(5, 7)),
|
||
list(name = "Toleranzentwicklung", items = c(2, 4)),
|
||
list(name = "Kontrollverlust", items = c(3, 10)),
|
||
list(name = "Verhaltensbezogene Einengung", items = c(11, 15)),
|
||
list(name = "Fortsetzung trotz psychosozialer Probleme", items = c(6, 14)),
|
||
list(name = "Luegen/Verheimlichen", items = c(13, 17)),
|
||
list(name = "Dysfunktionale Gefuehlsregulation", items = c(9, 12)),
|
||
list(name = "Gefaehrdung/Verluste", items = c(16, 18))
|
||
)
|
||
|
||
# Einordnung nach Anzahl erfuellter DSM-5-Kriterien (0-9).
|
||
CSAS_FP_EINORDNUNG_FARBEN = list(
|
||
"unauffaellig" = list(bg = "#E8F5E9", text = "#2E7D32", border = "#A5D6A7"),
|
||
"riskant" = list(bg = "#FFF3E0", text = "#E65100", border = "#FFCC80"),
|
||
"pathologisch" = list(bg = "#FFEBEE", text = "#B71C1C", border = "#EF9A9A")
|
||
)
|
||
|
||
CSAS_FP_STUFE_BADGE_FARBEN = c(
|
||
"0" = "#4CAF50",
|
||
"1" = "#F48FB1",
|
||
"2" = "#EF5350",
|
||
"3" = "#B71C1C"
|
||
)
|
||
CSAS_FP_STUFE_BADGE_TEXT_FARBEN = c(
|
||
"0" = "white",
|
||
"1" = "#333333",
|
||
"2" = "white",
|
||
"3" = "white"
|
||
)
|
||
|
||
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 ####
|
||
|
||
bereinige_markdown = function(x) {
|
||
x = gsub("\\*\\*", "", x)
|
||
x = gsub("(?<!\\\\)\\*", "", x, perl = TRUE)
|
||
x = gsub("\\\\\\.", ".", x)
|
||
x = trimws(x)
|
||
x
|
||
}
|
||
|
||
# Itemnummer vom Rest des Rohlabels trennen. Rohlabel beginnt mit
|
||
# Nummer + escaptem Punkt, z.B. "1\\. Mein Partner beschaeftigt sich ...".
|
||
trenne_itemnummer = function(rohlabel) {
|
||
if (is.null(rohlabel) || length(rohlabel) == 0 || is.na(rohlabel[1])) {
|
||
return(list(nr = NA_character_, text = NA_character_))
|
||
}
|
||
rohlabel = as.character(rohlabel[1])
|
||
m = regmatches(rohlabel, regexec("^(\\d+)\\\\\\.\\s*", rohlabel))[[1]]
|
||
if (length(m) == 2) {
|
||
nr = m[2]
|
||
rest = sub("^(\\d+)\\\\\\.\\s*", "", rohlabel)
|
||
} else {
|
||
nr = NA_character_
|
||
rest = rohlabel
|
||
}
|
||
list(nr = nr, text = bereinige_markdown(rest))
|
||
}
|
||
|
||
# Bestimmt den 1-basierten Index innerhalb von choice_texte, der zum
|
||
# Rohwert der Zelle passt. Deckt drei Kodierungsformate ab: haven-labelled,
|
||
# reiner (bereinigter) Text, und reiner numerischer 1-basierter Index.
|
||
# Gibt bei fehlendem Wert index = NA (kein Fehler); bei unbekanntem
|
||
# Speicherformat ok = FALSE mit Fehlermeldung.
|
||
hole_item_wert = function(spalte, zeilenwert, choice_texte, feldname = "") {
|
||
choice_texte_bereinigt = bereinige_markdown(choice_texte)
|
||
|
||
if (length(zeilenwert) == 0 || is.na(zeilenwert[1])) {
|
||
return(list(ok = TRUE, index = NA_integer_))
|
||
}
|
||
|
||
if (haven::is.labelled(spalte)) {
|
||
lbl_attr = attr(spalte, "labels")
|
||
if (is.null(lbl_attr) || length(lbl_attr) == 0) {
|
||
return(list(ok = FALSE, meldung = paste0(
|
||
"Unbekanntes Kodierungsformat in Spalte ", feldname,
|
||
" (haven_labelled ohne labels-Attribut), bitte manuell pruefen.")))
|
||
}
|
||
lbl_namen_bereinigt = bereinige_markdown(names(lbl_attr))
|
||
roh = suppressWarnings(as.numeric(zeilenwert[1]))
|
||
if (is.na(roh)) {
|
||
return(list(ok = FALSE, meldung = paste0(
|
||
"Unbekanntes Kodierungsformat in Spalte ", feldname,
|
||
" (Rohwert nicht numerisch), bitte manuell pruefen.")))
|
||
}
|
||
pos_in_labels = which(as.vector(lbl_attr) == roh)
|
||
if (length(pos_in_labels) == 0) {
|
||
return(list(ok = FALSE, meldung = paste0(
|
||
"Unbekanntes Kodierungsformat in Spalte ", feldname,
|
||
" (Rohwert nicht im labels-Attribut gefunden), bitte manuell pruefen.")))
|
||
}
|
||
label_text = lbl_namen_bereinigt[pos_in_labels[1]]
|
||
idx = match(label_text, choice_texte_bereinigt)
|
||
return(list(ok = TRUE, index = if (is.na(idx)) NA_integer_ else as.integer(idx)))
|
||
}
|
||
|
||
if (is.character(zeilenwert)) {
|
||
txt = bereinige_markdown(as.character(zeilenwert[1]))
|
||
idx = match(txt, choice_texte_bereinigt)
|
||
return(list(ok = TRUE, index = if (is.na(idx)) NA_integer_ else as.integer(idx)))
|
||
}
|
||
|
||
roh_numerisch = suppressWarnings(as.numeric(zeilenwert[1]))
|
||
if (!is.na(roh_numerisch) && roh_numerisch == round(roh_numerisch) && roh_numerisch >= 1) {
|
||
return(list(ok = TRUE, index = as.integer(roh_numerisch)))
|
||
}
|
||
|
||
list(ok = FALSE, meldung = paste0(
|
||
"Unbekanntes Kodierungsformat in Spalte ", feldname, ", bitte manuell pruefen."))
|
||
}
|
||
|
||
# Reine Anzeige-Hilfsfunktion (keine Recoding-Logik): liefert den
|
||
# bereinigten Anzeigetext einer Zelle, unabhaengig vom Kodierungsformat.
|
||
hole_anzeige_text = function(spalte, zeilenwert) {
|
||
if (length(zeilenwert) == 0 || is.na(zeilenwert[1])) return(NA_character_)
|
||
if (haven::is.labelled(spalte)) {
|
||
lbl_attr = attr(spalte, "labels")
|
||
if (!is.null(lbl_attr) && length(lbl_attr) > 0) {
|
||
roh = suppressWarnings(as.numeric(zeilenwert[1]))
|
||
pos = which(as.vector(lbl_attr) == roh)
|
||
if (length(pos) > 0) return(bereinige_markdown(names(lbl_attr)[pos[1]]))
|
||
}
|
||
return(as.character(zeilenwert[1]))
|
||
}
|
||
if (is.character(zeilenwert)) return(bereinige_markdown(as.character(zeilenwert[1])))
|
||
as.character(zeilenwert[1])
|
||
}
|
||
|
||
parse_hhmm_minuten = function(text) {
|
||
text = trimws(as.character(text))
|
||
if (length(text) == 0 || is.na(text) || text == "") return(NA_real_)
|
||
m = regmatches(text, regexec("^([0-9]{1,2}):([0-9]{2})$", text))[[1]]
|
||
if (length(m) != 3) return(NA_real_)
|
||
stunden = as.numeric(m[2])
|
||
minuten = as.numeric(m[3])
|
||
if (is.na(stunden) || is.na(minuten) || minuten > 59) return(NA_real_)
|
||
stunden * 60 + minuten
|
||
}
|
||
|
||
format_minuten_hhmm = function(minuten) {
|
||
if (is.na(minuten)) return("k. A.")
|
||
h = floor(minuten / 60)
|
||
m = round(minuten %% 60)
|
||
if (m == 60) { m = 0; h = h + 1 }
|
||
sprintf("%d Std. %02d Min.", h, m)
|
||
}
|
||
|
||
# Kernitem-Feldname fuer Nummer i (1-18).
|
||
csas_fp_item_feld = function(i) paste0("csas_fp_", sprintf("%02d", i))
|
||
|
||
make_kriterien_balken = function(anzahl) {
|
||
ggplot() +
|
||
geom_rect(aes(xmin = -0.5, xmax = 1.5, ymin = 0, ymax = 1), fill = "#E8F5E9", color = NA) +
|
||
geom_rect(aes(xmin = 1.5, xmax = 4.5, ymin = 0, ymax = 1), fill = "#FFF3E0", color = NA) +
|
||
geom_rect(aes(xmin = 4.5, xmax = 9.5, ymin = 0, ymax = 1), fill = "#FFEBEE", color = NA) +
|
||
geom_rect(aes(xmin = -0.5, xmax = 9.5, ymin = 0, ymax = 1),
|
||
fill = NA, color = "#9E9E9E", linewidth = 0.6) +
|
||
geom_segment(aes(x = anzahl, xend = anzahl, y = -0.25, yend = 1.25),
|
||
color = AKZENT_FARBE, linewidth = 2.5) +
|
||
geom_label(aes(x = anzahl, y = 1.6, label = paste0(anzahl, " / 9")),
|
||
fill = AKZENT_FARBE, color = "white", fontface = "bold",
|
||
linewidth = 0, size = 4) +
|
||
annotate("text", x = 0.5, y = -0.55, label = "0-1: unauffaellig",
|
||
color = "#2E7D32", size = 3.0, hjust = 0.5) +
|
||
annotate("text", x = 3, y = -0.55, label = "2-4: riskant",
|
||
color = "#E65100", size = 3.0, hjust = 0.5) +
|
||
annotate("text", x = 7, y = -0.55, label = "5-9: pathologisch",
|
||
color = "#B71C1C", size = 3.0, hjust = 0.5) +
|
||
scale_x_continuous(limits = c(-1, 10), breaks = 0:9) +
|
||
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 = 15, l = 10)
|
||
) +
|
||
labs(x = "Anzahl erfuellter DSM-5-Kriterien (0-9)", y = NULL)
|
||
}
|
||
|
||
csas_fp_einordnung = function(anzahl_kriterien) {
|
||
if (anzahl_kriterien <= 1) {
|
||
list(
|
||
key = "unauffaellig",
|
||
titel = "Unauffaellig",
|
||
text = paste0(
|
||
anzahl_kriterien, " von 9 DSM-5-Kriterien erfuellt. Kein Hinweis auf ",
|
||
"problematisches Computerspielverhalten aus Sicht des Partners."
|
||
)
|
||
)
|
||
} else if (anzahl_kriterien <= 4) {
|
||
list(
|
||
key = "riskant",
|
||
titel = "Riskant / moegliche Gefaehrdung",
|
||
text = paste0(
|
||
anzahl_kriterien, " von 9 DSM-5-Kriterien erfuellt. Aus Sicht des Partners ",
|
||
"bestehen Hinweise auf ein riskantes Spielverhalten."
|
||
)
|
||
)
|
||
} else {
|
||
list(
|
||
key = "pathologisch",
|
||
titel = "Pathologisch / Verdacht auf Internet Gaming Disorder (IGD)",
|
||
text = paste0(
|
||
anzahl_kriterien, " von 9 DSM-5-Kriterien erfuellt. Aus Sicht des Partners ",
|
||
"bestehen deutliche Hinweise auf ein pathologisches Spielverhalten. ",
|
||
"Der Cutoff von 5 Kriterien ist laut Testmanual eine pragmatische, bewusst ",
|
||
"konservative Konvention und keine harte Diagnoseschwelle."
|
||
)
|
||
)
|
||
}
|
||
}
|
||
|
||
|
||
# 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; }
|
||
.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;
|
||
}
|
||
.ergaenzung-box {
|
||
background: #FFF3E0; border: 2px solid #E65100; border-left: 8px solid #E65100;
|
||
border-radius: 6px; padding: 14px 20px; margin-bottom: 20px;
|
||
color: #7A2E00; box-shadow: 0 1px 4px rgba(0,0,0,.15);
|
||
}
|
||
.ergaenzung-titel { font-weight: 800; font-size: 1.02rem; margin-bottom: 4px; }
|
||
.ergaenzung-text { font-size: 0.92em; line-height: 1.5; }
|
||
.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; }
|
||
.geraet-zeile {
|
||
display: flex; gap: 8px; align-items: baseline;
|
||
padding: 4px 0; color: #444; font-size: 0.93em; border-bottom: 1px solid #F0F0F0;
|
||
}
|
||
.geraet-label { font-weight: 600; color: #333; min-width: 180px; }
|
||
.geraet-nie { color: #2E7D32; }
|
||
.geraet-genutzt { color: #B71C1C; font-weight: 600; }
|
||
.einordnung-box {
|
||
border-radius: 6px; padding: 14px 18px; margin: 12px 0;
|
||
border-left: 5px solid;
|
||
}
|
||
.einordnung-titel { font-weight: 700; font-size: 1.05rem; margin-bottom: 6px; }
|
||
.einordnung-text { font-size: 0.93em; line-height: 1.55; }
|
||
.einordnung-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;
|
||
}
|
||
.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; }
|
||
.cutoff-info { font-size: 0.88em; color: #555; margin-top: 4px; }
|
||
.kriterien-tabelle { width: 100%; border-collapse: collapse; font-size: 0.9em; }
|
||
.kriterien-tabelle th, .kriterien-tabelle td {
|
||
text-align: left; padding: 6px 10px; border-bottom: 1px solid #F0F0F0;
|
||
}
|
||
.kriterien-tabelle th { color: #8B2635; font-weight: 700; }
|
||
.badge-erfuellt-ja { color: #B71C1C; font-weight: 700; }
|
||
.badge-erfuellt-nein { color: #2E7D32; font-weight: 600; }
|
||
.info-block { font-size: 0.86em; color: #666; font-style: italic; margin-top: 6px; }
|
||
.freitext-block { font-size: 0.92em; color: #333; }
|
||
"
|
||
|
||
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("CSAS-FP – Computerspielabhaengigkeitsskala, Fremdbeurteilung durch den Partner"),
|
||
tags$p("Auswertung nach Testmanual, DSM-5-Kriterien-basiert")
|
||
),
|
||
|
||
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 = "Chiffre der Zielperson",
|
||
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_csas_fp_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_ergaenzung_titel = fp_text(bold = TRUE, font.size = 11,
|
||
color = "#7A2E00", shading.color = "#FFE0B2")
|
||
fp_ergaenzung_text = fp_text(font.size = 10,
|
||
color = "#7A2E00", shading.color = "#FFF3E0")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("CSAS-FP - Einzelauswertung (Fremdbeurteilung)", fp_titel)))
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext("Chiffre der Zielperson: ", 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("Wichtiger Hinweis", fp_ergaenzung_titel)))
|
||
doc = body_add_fpar(doc, fpar(ftext(CSAS_FP_ERGAENZUNGSHINWEIS, fp_ergaenzung_text)))
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("Kopfdaten (Partner)", fp_abschnitt)))
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext("Alter des Partners: ", fp_label),
|
||
ftext(erg$alter_text, fp_normal)
|
||
))
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext("Geschlecht des Partners: ", fp_label),
|
||
ftext(erg$geschlecht_text, fp_normal)
|
||
))
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("Geraetenutzung des Partners", fp_abschnitt)))
|
||
for (f in CSAS_FP_GERAET_FELDER) {
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(paste0(CSAS_FP_GERAET_LABELS[[f]], ": "), fp_label),
|
||
ftext(erg$geraet_texte[[f]], fp_normal)
|
||
))
|
||
}
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
if (erg$fall == "kein_spiel") {
|
||
doc = body_add_fpar(doc, fpar(ftext(
|
||
"Kein Computerspielverhalten des Partners in den letzten 12 Monaten berichtet ",
|
||
fp_normal)))
|
||
doc = body_add_fpar(doc, fpar(ftext(
|
||
"(alle Geraetetypen 'nie'). CSAS-Summenwert und DSM-5-Kriterien sind fuer diesen ",
|
||
"Fall nicht relevant (Ableitung aus der Bogenlogik).", fp_normal)))
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
doc = body_add_fpar(doc, fpar(ftext(CSAS_FP_DISCLAIMER, fp_disclaimer)))
|
||
return(doc)
|
||
}
|
||
|
||
if (erg$fall == "unvollstaendig") {
|
||
doc = body_add_fpar(doc, fpar(ftext(
|
||
"Die 18 Kernitems sind nicht vollstaendig beantwortet. Eine Auswertung von ",
|
||
"CSAS-Summenwert und DSM-5-Kriterien ist daher nicht moeglich.",
|
||
fp_text(font.size = 11, bold = TRUE, color = "#E65100"))))
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
doc = body_add_fpar(doc, fpar(ftext(CSAS_FP_DISCLAIMER, fp_disclaimer)))
|
||
return(doc)
|
||
}
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("Mittlere taegliche Spielzeit des Partners", fp_abschnitt)))
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(paste0(erg$spielzeit_text, " (", round(erg$spielzeit_minuten), " Minuten)"), fp_normal)
|
||
))
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("CSAS-Summenwert", fp_abschnitt)))
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(paste0(erg$summenwert, " / 54"),
|
||
fp_text(bold = TRUE, font.size = 12, color = AKZENT_FARBE))
|
||
))
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
ein_key = erg$einordnung$key
|
||
ein_farbe = CSAS_FP_EINORDNUNG_FARBEN[[ein_key]]
|
||
fp_ein_titel = fp_text(bold = TRUE, font.size = 12,
|
||
color = ein_farbe$text, shading.color = ein_farbe$bg)
|
||
fp_ein_text = fp_text(font.size = 11,
|
||
color = ein_farbe$text, shading.color = ein_farbe$bg)
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("DSM-5-Kriterien", fp_abschnitt)))
|
||
for (i in seq_along(CSAS_FP_KRITERIEN)) {
|
||
k = CSAS_FP_KRITERIEN[[i]]
|
||
erfuellt = erg$kriterien_erfuellt[i]
|
||
fp_ja_nein = if (isTRUE(erfuellt))
|
||
fp_text(bold = TRUE, font.size = 10, color = "#B71C1C")
|
||
else
|
||
fp_text(font.size = 10, color = "#2E7D32")
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(paste0(i, ". ", k$name, " (Items ", paste(k$items, collapse = ", "), "): "), fp_normal),
|
||
ftext(if (isTRUE(erfuellt)) "erfuellt" else "nicht erfuellt", fp_ja_nein)
|
||
))
|
||
}
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("Einordnung", fp_abschnitt)))
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(paste0(erg$anzahl_kriterien, " von 9 Kriterien erfuellt: ", erg$einordnung$titel),
|
||
fp_ein_titel)
|
||
))
|
||
doc = body_add_fpar(doc, fpar(ftext(erg$einordnung$text, fp_ein_text)))
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("Normwerte", fp_abschnitt)))
|
||
doc = body_add_fpar(doc, fpar(ftext(CSAS_FP_KEINE_NORMWERTE_HINWEIS, fp_normal)))
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("CSAS-FP Einzelitems", fp_abschnitt)))
|
||
for (i in seq_len(18)) {
|
||
stufe = erg$item_werte[i]
|
||
stufe_key = if (!is.na(stufe) && stufe >= 0L && stufe <= 3L) as.character(stufe) else "0"
|
||
antwort = if (!is.na(stufe)) CSAS_FP_CHOICE_TEXTE[stufe + 1L] else "k. A."
|
||
item_txt = if (!is.na(erg$item_texte[i])) erg$item_texte[i] else paste0("Item ", i)
|
||
|
||
fp_badge = fp_text(
|
||
color = CSAS_FP_STUFE_BADGE_TEXT_FARBEN[[stufe_key]],
|
||
bold = TRUE,
|
||
shading.color = CSAS_FP_STUFE_BADGE_FARBEN[[stufe_key]],
|
||
font.size = 10
|
||
)
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(paste0(i, ". ", item_txt, " "), fp_normal),
|
||
ftext(paste0(" ", antwort, " "), fp_badge)
|
||
))
|
||
}
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("Genannte Spiele des Partners", fp_abschnitt)))
|
||
doc = body_add_fpar(doc, fpar(ftext(erg$spiele_text, fp_normal)))
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext(CSAS_FP_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)))
|
||
}
|
||
})
|
||
|
||
# Skripte werden NICHT beim App-Start gesourct, nur beim Klick auf "Auswerten".
|
||
ergebnis_r = eventReactive(input$btn_suchen, {
|
||
|
||
chiffre = toupper(trimws(input$chiffre))
|
||
|
||
if ((nchar(trimws(input$pseudonym)) == 0 && nchar(chiffre) == 0)) {
|
||
return(list(error = "Bitte eine Chiffre 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 = 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 (!ok$ok) return(list(error = paste0("Fehler im Pseudonym-Skript: ", ok$msg)))
|
||
|
||
if (!exists("daten_csas_fp", envir = .GlobalEnv)) {
|
||
return(list(error = paste0(
|
||
"Objekt 'daten_csas_fp' 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 = get("daten_csas_fp", envir = .GlobalEnv)
|
||
pseudo_df = get("pseudo", envir = .GlobalEnv)
|
||
|
||
if (!("created" %in% names(daten))) {
|
||
return(list(error = paste0(
|
||
"Erwartete Spalte 'created' (Ausfuelldatum) in 'daten_csas_fp' nicht gefunden. ",
|
||
"Bitte pruefen, unter welchem Namen das Ausfuelldatum vorliegt.")))
|
||
}
|
||
|
||
treffer_ps = pseudo_df[pseudo_df$chiffre == chiffre, ]
|
||
if (nrow(treffer_ps) == 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[daten$session %in% alle_session_ids, ]
|
||
if (nrow(treffer_dat) == 0) {
|
||
return(list(error = paste0(
|
||
"Kein CSAS-FP-Datensatz fuer Chiffre '", chiffre, "' gefunden. ",
|
||
"(", length(alle_session_ids), " Pseudonym(e) geprueft)")))
|
||
}
|
||
|
||
info_mehrere = NULL
|
||
if (nrow(treffer_dat) > 1) {
|
||
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]
|
||
}
|
||
|
||
zeile = treffer_dat[1, , drop = FALSE]
|
||
|
||
datum_parsed = tryCatch(as.POSIXct(zeile[["created"]][1]), error = function(e) NA)
|
||
if (length(datum_parsed) == 0 || is.na(datum_parsed)) {
|
||
return(list(error = paste0(
|
||
"Das Ausfuelldatum ('created') konnte nicht geparst werden. ",
|
||
"Rohwert: '", as.character(zeile[["created"]][1]), "'. Bitte manuell pruefen.")))
|
||
}
|
||
datum_str = format(datum_parsed, "%d.%m.%Y")
|
||
datum_yyyymmdd = format(datum_parsed, "%Y%m%d")
|
||
|
||
# --- Kopfdaten des Partners ---
|
||
alter_roh = zeile[["csas_fp_alter"]][1]
|
||
alter_text = if (is.null(alter_roh) || is.na(alter_roh)) "k. A." else as.character(alter_roh)
|
||
|
||
geschlecht_text = hole_anzeige_text(daten[["csas_fp_geschlecht"]], zeile[["csas_fp_geschlecht"]])
|
||
geschlecht_text = if (is.na(geschlecht_text)) "k. A." else geschlecht_text
|
||
|
||
# --- Geraetenutzung des Partners ---
|
||
geraet_texte = list()
|
||
geraet_ist_nie = logical(length(CSAS_FP_GERAET_FELDER))
|
||
names(geraet_ist_nie) = CSAS_FP_GERAET_FELDER
|
||
|
||
for (f in CSAS_FP_GERAET_FELDER) {
|
||
r = hole_item_wert(daten[[f]], zeile[[f]], CSAS_FP_GERAET_NIE_TEXT, feldname = f)
|
||
if (!r$ok) return(list(error = r$meldung))
|
||
geraet_ist_nie[[f]] = isTRUE(r$index == 1L)
|
||
anzeige = hole_anzeige_text(daten[[f]], zeile[[f]])
|
||
geraet_texte[[f]] = if (is.na(anzeige)) "k. A." else anzeige
|
||
}
|
||
|
||
alle_geraete_nie = all(geraet_ist_nie)
|
||
|
||
# --- Freitext: genannte Spiele ---
|
||
unbekannt_roh = zeile[["csas_fp_spiele_unbekannt"]][1]
|
||
spiele_unbekannt = !is.null(unbekannt_roh) && !is.na(unbekannt_roh) &&
|
||
suppressWarnings(as.numeric(unbekannt_roh)) == 1
|
||
|
||
if (isTRUE(spiele_unbekannt)) {
|
||
spiele_text = "Namen der Spiele laut Angabe nicht bekannt"
|
||
} else {
|
||
spielnamen = sapply(c("csas_fp_spiel1", "csas_fp_spiel2", "csas_fp_spiel3"), function(f) {
|
||
v = zeile[[f]][1]
|
||
if (is.null(v) || is.na(v) || trimws(as.character(v)) == "") return(NA_character_)
|
||
bereinige_markdown(as.character(v))
|
||
})
|
||
spielnamen = spielnamen[!is.na(spielnamen)]
|
||
spiele_text = if (length(spielnamen) == 0)
|
||
"Keine Angabe" else paste(spielnamen, collapse = ", ")
|
||
}
|
||
|
||
basis = list(
|
||
chiffre = chiffre,
|
||
datum_str = datum_str,
|
||
datum_yyyymmdd = datum_yyyymmdd,
|
||
info_mehrere = info_mehrere,
|
||
alter_text = alter_text,
|
||
geschlecht_text = geschlecht_text,
|
||
geraet_texte = geraet_texte,
|
||
spiele_text = spiele_text,
|
||
error = NULL
|
||
)
|
||
|
||
# Fall 1: Kein Spielverhalten -> Kernitems und Spielzeit wurden per
|
||
# showif gar nicht angezeigt.
|
||
if (alle_geraete_nie) {
|
||
return(c(basis, list(fall = "kein_spiel")))
|
||
}
|
||
|
||
# --- Kernitems (18) ---
|
||
item_texte = character(18)
|
||
item_nrn = character(18)
|
||
item_werte = integer(18)
|
||
item_antw = character(18)
|
||
|
||
for (i in seq_len(18)) {
|
||
f = csas_fp_item_feld(i)
|
||
lab = trenne_itemnummer(attr(daten[[f]], "label"))
|
||
item_texte[i] = lab$text
|
||
item_nrn[i] = if (!is.na(lab$nr)) lab$nr else as.character(i)
|
||
|
||
r = hole_item_wert(daten[[f]], zeile[[f]], CSAS_FP_CHOICE_TEXTE, feldname = f)
|
||
if (!r$ok) return(list(error = r$meldung))
|
||
item_werte[i] = if (is.na(r$index)) NA_integer_ else as.integer(r$index - 1L)
|
||
item_antw[i] = if (!is.na(item_werte[i])) CSAS_FP_CHOICE_TEXTE[item_werte[i] + 1L] else NA_character_
|
||
}
|
||
|
||
# Fall 2: nicht alle 18 Kernitems vollstaendig beantwortet.
|
||
if (any(is.na(item_werte))) {
|
||
return(c(basis, list(
|
||
fall = "unvollstaendig",
|
||
item_texte = item_texte,
|
||
item_nrn = item_nrn,
|
||
item_werte = item_werte,
|
||
item_antw = item_antw
|
||
)))
|
||
}
|
||
|
||
# --- Fall 3: vollstaendige Auswertung ---
|
||
summenwert = sum(item_werte)
|
||
|
||
werktag_min = parse_hhmm_minuten(zeile[["csas_fp_stunden_werktag"]][1])
|
||
wochenende_min = parse_hhmm_minuten(zeile[["csas_fp_stunden_wochenende"]][1])
|
||
spielzeit_minuten = if (is.na(werktag_min) || is.na(wochenende_min))
|
||
NA_real_ else (werktag_min * 5 + wochenende_min * 2) / 7
|
||
spielzeit_text = format_minuten_hhmm(spielzeit_minuten)
|
||
|
||
kriterien_erfuellt = sapply(CSAS_FP_KRITERIEN, function(k) {
|
||
werte_k = item_werte[k$items]
|
||
any(werte_k == 3, na.rm = TRUE)
|
||
})
|
||
anzahl_kriterien = sum(kriterien_erfuellt)
|
||
einordnung = csas_fp_einordnung(anzahl_kriterien)
|
||
|
||
c(basis, list(
|
||
fall = "vollstaendig",
|
||
item_texte = item_texte,
|
||
item_nrn = item_nrn,
|
||
item_werte = item_werte,
|
||
item_antw = item_antw,
|
||
summenwert = summenwert,
|
||
spielzeit_minuten = spielzeit_minuten,
|
||
spielzeit_text = spielzeit_text,
|
||
kriterien_erfuellt = kriterien_erfuellt,
|
||
anzahl_kriterien = anzahl_kriterien,
|
||
einordnung = einordnung
|
||
))
|
||
})
|
||
|
||
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)
|
||
|
||
geraet_ui = lapply(CSAS_FP_GERAET_FELDER, function(f) {
|
||
div(class = "geraet-zeile",
|
||
div(class = "geraet-label", CSAS_FP_GERAET_LABELS[[f]]),
|
||
div(erg$geraet_texte[[f]])
|
||
)
|
||
})
|
||
|
||
kopf_und_geraete = tagList(
|
||
div(class = "ergaenzung-box",
|
||
div(class = "ergaenzung-titel", "Wichtiger Hinweis zur Fremdbeurteilung"),
|
||
div(class = "ergaenzung-text", CSAS_FP_ERGAENZUNGSHINWEIS)
|
||
),
|
||
|
||
div(class = "abschnitt-karte",
|
||
div(class = "abschnitt-titel", "CSAS-FP – Fremdbeurteilung durch den Partner"),
|
||
|
||
div(class = "meta-block",
|
||
tags$strong("Chiffre der Zielperson: "), erg$chiffre,
|
||
tags$span(" | ", style = "color:#ccc;"),
|
||
tags$strong("Ausfuelldatum: "), erg$datum_str
|
||
),
|
||
|
||
tags$hr(),
|
||
|
||
tags$h5("Kopfdaten des Partners"),
|
||
div(class = "kontext-zeile",
|
||
div(class = "kontext-label", "Alter des Partners:"),
|
||
div(erg$alter_text)
|
||
),
|
||
div(class = "kontext-zeile",
|
||
div(class = "kontext-label", "Geschlecht des Partners:"),
|
||
div(erg$geschlecht_text)
|
||
),
|
||
|
||
tags$hr(),
|
||
|
||
tags$h5("Geraetenutzung des Partners"),
|
||
div(geraet_ui)
|
||
)
|
||
)
|
||
|
||
if (erg$fall == "kein_spiel") {
|
||
return(tagList(
|
||
kopf_und_geraete,
|
||
div(class = "abschnitt-karte",
|
||
div(class = "abschnitt-titel", "Auswertung"),
|
||
div(class = "alert-warnung",
|
||
paste0(
|
||
"Kein Computerspielverhalten des Partners in den letzten 12 Monaten ",
|
||
"berichtet (alle Geraetetypen 'nie'). CSAS-Summenwert und DSM-5-Kriterien ",
|
||
"sind fuer diesen Fall nicht relevant."
|
||
)
|
||
),
|
||
div(class = "info-block",
|
||
"Hinweis: Diese Einordnung ist eine Ableitung aus der Bogenlogik ",
|
||
"(showif-Steuerung in formr), keine woertliche Aussage des Testmanuals.")
|
||
)
|
||
))
|
||
}
|
||
|
||
if (erg$fall == "unvollstaendig") {
|
||
return(tagList(
|
||
kopf_und_geraete,
|
||
div(class = "abschnitt-karte",
|
||
div(class = "abschnitt-titel", "Auswertung"),
|
||
div(class = "alert-warnung",
|
||
"Die 18 Kernitems sind nicht vollstaendig beantwortet. Eine Auswertung von ",
|
||
"CSAS-Summenwert und DSM-5-Kriterien ist daher nicht moeglich."
|
||
)
|
||
)
|
||
))
|
||
}
|
||
|
||
ein_key = erg$einordnung$key
|
||
|
||
kriterien_zeilen = lapply(seq_along(CSAS_FP_KRITERIEN), function(i) {
|
||
k = CSAS_FP_KRITERIEN[[i]]
|
||
erfuellt = erg$kriterien_erfuellt[i]
|
||
werte_k = erg$item_werte[k$items]
|
||
tags$tr(
|
||
tags$td(paste0(i, ". ", k$name)),
|
||
tags$td(paste0("Items ", paste(k$items, collapse = ", "),
|
||
" (Werte: ", paste(werte_k, collapse = ", "), ")")),
|
||
tags$td(
|
||
if (isTRUE(erfuellt))
|
||
span(class = "badge-erfuellt-ja", "erfuellt")
|
||
else
|
||
span(class = "badge-erfuellt-nein", "nicht erfuellt")
|
||
)
|
||
)
|
||
})
|
||
|
||
items_ui = lapply(seq_len(18), function(i) {
|
||
stufe = erg$item_werte[i]
|
||
sk = if (!is.na(stufe) && stufe >= 0L && stufe <= 3L) as.character(stufe) else "0"
|
||
antw = if (!is.na(erg$item_antw[i])) erg$item_antw[i] else "k. A."
|
||
|
||
div(class = "item-zeile",
|
||
div(class = "item-nr", paste0(erg$item_nrn[i], ".")),
|
||
div(class = "item-text", erg$item_texte[i]),
|
||
span(class = paste0("stufe-badge stufe-badge-", sk), antw)
|
||
)
|
||
})
|
||
|
||
tagList(
|
||
kopf_und_geraete,
|
||
|
||
div(class = "abschnitt-karte",
|
||
div(class = "abschnitt-titel", "Spielzeit und CSAS-Summenwert"),
|
||
|
||
div(class = "kontext-zeile",
|
||
div(class = "kontext-label", "Mittlere taegliche Spielzeit des Partners:"),
|
||
div(paste0(erg$spielzeit_text, " (", round(erg$spielzeit_minuten), " Minuten)"))
|
||
),
|
||
|
||
tags$hr(),
|
||
|
||
fluidRow(
|
||
column(3,
|
||
div(
|
||
div(class = "score-zahl", erg$summenwert),
|
||
div("CSAS-Summenwert (0-54)", style = "color:#555;")
|
||
)
|
||
),
|
||
column(9,
|
||
div(class = "info-block", CSAS_FP_KEINE_NORMWERTE_HINWEIS)
|
||
)
|
||
)
|
||
),
|
||
|
||
div(class = "abschnitt-karte",
|
||
div(class = "abschnitt-titel", "DSM-5-Kriterien"),
|
||
tags$table(class = "kriterien-tabelle",
|
||
tags$thead(
|
||
tags$tr(tags$th("Kriterium"), tags$th("Items"), tags$th("Erfuellt"))
|
||
),
|
||
tags$tbody(kriterien_zeilen)
|
||
),
|
||
|
||
tags$hr(),
|
||
|
||
plotOutput("kriterien_plot", height = "160px"),
|
||
|
||
div(class = paste0("einordnung-box"),
|
||
style = paste0(
|
||
"background:", CSAS_FP_EINORDNUNG_FARBEN[[ein_key]]$bg, ";",
|
||
"border-color:", CSAS_FP_EINORDNUNG_FARBEN[[ein_key]]$border, ";",
|
||
"color:", CSAS_FP_EINORDNUNG_FARBEN[[ein_key]]$text, ";"
|
||
),
|
||
div(class = "einordnung-titel",
|
||
paste0(erg$anzahl_kriterien, " von 9 Kriterien erfuellt: ", erg$einordnung$titel)),
|
||
div(class = "einordnung-text", erg$einordnung$text)
|
||
)
|
||
),
|
||
|
||
div(class = "abschnitt-karte",
|
||
div(class = "abschnitt-titel", "CSAS-FP Einzelitems"),
|
||
div(items_ui)
|
||
),
|
||
|
||
div(class = "abschnitt-karte",
|
||
div(class = "abschnitt-titel", "Genannte Spiele des Partners"),
|
||
div(class = "freitext-block", erg$spiele_text)
|
||
)
|
||
)
|
||
})
|
||
|
||
output$kriterien_plot = renderPlot({
|
||
req(input$btn_suchen)
|
||
erg = ergebnis_r()
|
||
req(is.null(erg$error))
|
||
req(identical(erg$fall, "vollstaendig"))
|
||
make_kriterien_balken(erg$anzahl_kriterien)
|
||
}, bg = "transparent")
|
||
|
||
output$download_word = downloadHandler(
|
||
filename = function() {
|
||
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||
hat_daten = is.list(erg) && is.null(erg$error) && !is.null(erg$datum_yyyymmdd)
|
||
chiffre = if (hat_daten) erg$chiffre else "export"
|
||
datum = if (hat_daten) erg$datum_yyyymmdd else format(Sys.Date(), "%Y%m%d")
|
||
paste0("CSASFP_", 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 eingeben und 'Auswerten' klicken.",
|
||
style = "Normal")
|
||
print(doc, target = file)
|
||
return()
|
||
}
|
||
doc = tryCatch(
|
||
erstelle_csas_fp_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)
|