905 lines
37 KiB
R
905 lines
37 KiB
R
# Präambel ####
|
||
|
||
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_vds24.R" # liefert: daten_vds24
|
||
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R" # liefert: pseudo
|
||
AKZENT_FARBE = "#8B2635"
|
||
|
||
VDS24_DISCLAIMER = paste0(
|
||
"Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
|
||
"keine klinische Diagnose. Es liegen keine Normwerte oder Vergleichsstichproben vor; ",
|
||
"die Interpretation der Faktorwerte obliegt der behandelnden Person."
|
||
)
|
||
VDS24_DISCLAIMER = gsub("fuer", "für", VDS24_DISCLAIMER, fixed = TRUE)
|
||
|
||
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 ####
|
||
|
||
# Stufenwert (0-5) wird ausschliesslich aus dem Label-Text extrahiert (fuehrende
|
||
# Ziffer vor " = "), niemals aus dem Rohcode selbst - der Rohcode ist typischerweise
|
||
# 1-indiziert und die genaue Kodierung kann je nach formr-Instanz variieren.
|
||
item_score = function(daten, feldname) {
|
||
x = daten[[feldname]]
|
||
labels_attr = attr(x, "labels")
|
||
if (is.null(labels_attr)) return(as.numeric(x))
|
||
treffer = match(as.numeric(x), as.numeric(labels_attr))
|
||
as.numeric(sub("^(\\d+).*", "\\1", names(labels_attr)[treffer]))
|
||
}
|
||
|
||
# OFFENER PUNKT FUER ERSTEN TESTLAUF (Spezifikation Abschnitt 7.5 / 12.1):
|
||
# Exportformat der mc_multiple-Felder (_vm) ist fuer diese formr-Instanz nicht
|
||
# durch echte Testdaten verifiziert. Deckt defensiv zwei plausible Formate ab:
|
||
# mehrere Boolean-/Label-Spalten je Choice, oder eine Spalte mit
|
||
# komma-/semikolongetrennter Werteliste.
|
||
vater_mutter_lesen = function(daten, feld_vm) {
|
||
einzelspalten = grep(paste0("^", feld_vm, "(_|$)"), names(daten), value = TRUE)
|
||
if (length(einzelspalten) > 1) {
|
||
treffer = einzelspalten[sapply(daten[einzelspalten], function(x) isTRUE(as.logical(x)) || identical(as.character(x), "1"))]
|
||
ergebnis = gsub(paste0("^", feld_vm, "_"), "", treffer)
|
||
} else if (feld_vm %in% names(daten)) {
|
||
roh = as.character(daten[[feld_vm]])
|
||
ergebnis = trimws(strsplit(roh, "[,;]")[[1]])
|
||
ergebnis = ergebnis[nchar(ergebnis) > 0]
|
||
} else {
|
||
ergebnis = character(0)
|
||
}
|
||
ergebnis
|
||
}
|
||
|
||
# Rohwerte aus vater_mutter_lesen() (Choice-Text oder Spaltensuffix) auf eine
|
||
# der vier Anzeigekategorien abbilden. Nicht erkennbare Rohwerte werden
|
||
# transparent mitangezeigt statt stillschweigend verworfen.
|
||
vds24_vm_anzeige = function(rohwerte) {
|
||
rohwerte = trimws(as.character(rohwerte))
|
||
rohwerte = rohwerte[!is.na(rohwerte) & nchar(rohwerte) > 0]
|
||
hat_vater = any(grepl("vater", rohwerte, ignore.case = TRUE))
|
||
hat_mutter = any(grepl("mutter", rohwerte, ignore.case = TRUE))
|
||
if (hat_vater && hat_mutter) return("Vater und Mutter")
|
||
if (hat_vater) return("Vater")
|
||
if (hat_mutter) return("Mutter")
|
||
if (length(rohwerte) > 0) return(paste0("keine Angabe (roh: ", paste(rohwerte, collapse = ", "), ")"))
|
||
"keine Angabe"
|
||
}
|
||
|
||
# Faktor-Rohwertsumme und -Mittelwert (0-5). NA-Items werden aus Summe UND
|
||
# Anzahl-Divisor ausgeschlossen (Abschnitt 7.2) statt stillschweigend mit
|
||
# falschem Mittelwert zu rechnen.
|
||
vds24_faktor_auswerten = function(werte) {
|
||
vorhanden = !is.na(werte)
|
||
n_vorhanden = sum(vorhanden)
|
||
n_gesamt = length(werte)
|
||
rohsumme = if (n_vorhanden > 0) sum(werte[vorhanden]) else NA_real_
|
||
mittelwert = if (n_vorhanden > 0) rohsumme / n_vorhanden else NA_real_
|
||
list(rohsumme = rohsumme, mittelwert = mittelwert, n_vorhanden = n_vorhanden, n_gesamt = n_gesamt)
|
||
}
|
||
|
||
# Profilwert (0-3-Skala) nur fuer die Diagrammachse, siehe Abschnitt 7.3.
|
||
vds24_profilwert = function(mittelwert) mittelwert * 3 / 5
|
||
|
||
# Freitext lesen, leere/NA-Werte einheitlich als NA_character_.
|
||
vds24_text_feld = function(zeile, feldname) {
|
||
if (!(feldname %in% names(zeile))) return(NA_character_)
|
||
roh = zeile[[feldname]][1]
|
||
if (is.null(roh) || is.na(roh)) return(NA_character_)
|
||
txt = trimws(as.character(roh))
|
||
if (nchar(txt) == 0) NA_character_ else txt
|
||
}
|
||
|
||
# Die Rangfolge-Wahlfelder sind vom Typ "select_one <listname>" und
|
||
# referenzieren eine externe Choice-Liste (blocka/blockb/blockc/blockab/alle
|
||
# im choices-Blatt der Formular-xlsx) - anders als die 21 Ratingitems (Typ
|
||
# "mc" mit inline definierten Choices), die als numerischer Code + labels-
|
||
# Attribut exportiert werden. formr exportiert select_one-Felder mit
|
||
# Listenreferenz typischerweise als internen Choice-NAMEN (z.B. "blockc3"),
|
||
# nicht als Klartext - eine direkte haven::as_factor()-Umwandlung liefert in
|
||
# dem Fall nur den unveraenderten internen Code zurueck. Der interne Name
|
||
# kodiert die Item-Nummer nach einem festen, aus der xlsx abgelesenen Schema,
|
||
# das hier zur Aufloesung genutzt wird.
|
||
VDS24_WAHL_LISTEN = list(
|
||
list(prefix = "blockab", zu_nr = function(n) as.character(n)),
|
||
list(prefix = "blocka", zu_nr = function(n) as.character(n)),
|
||
list(prefix = "blockb", zu_nr = function(n) as.character(n)),
|
||
list(prefix = "blockc", zu_nr = function(n) paste0("H", n)),
|
||
list(prefix = "a", zu_nr = function(n) if (n <= 14) as.character(n) else paste0("H", n - 14))
|
||
)
|
||
|
||
# Rohwert (interner Choice-Name ODER bereits aufgeloester Klartext) auf
|
||
# Item-Nummer + Kurztext abbilden. Prefixe sind absteigend nach Laenge
|
||
# geprueft ("blockab" vor "blocka"), damit z.B. "blockab3" nicht faelschlich
|
||
# als Praefix "blocka" + Rest "b3" fehlinterpretiert wird.
|
||
vds24_wahl_zu_item = function(roh) {
|
||
x = trimws(as.character(roh))
|
||
if (is.na(x) || nchar(x) == 0) return(NULL)
|
||
|
||
for (liste in VDS24_WAHL_LISTEN) {
|
||
if (grepl(paste0("^", liste$prefix, "[0-9]+$"), x)) {
|
||
num = as.integer(sub(paste0("^", liste$prefix), "", x))
|
||
nr = liste$zu_nr(num)
|
||
treffer = which(VDS24_ITEMS$nr == nr)
|
||
if (length(treffer) == 1) {
|
||
return(list(nr = nr, kurztext = VDS24_ITEMS$kurztext[treffer]))
|
||
}
|
||
}
|
||
}
|
||
|
||
# Fallback: Rohwert ist evtl. bereits Klartext (z.B. "3. Zuverlaessiger
|
||
# Schutz") - fuehrende Nummerierung entfernen und gegen die bekannten
|
||
# Kurztexte matchen, statt den Rohwert unerklaert stehen zu lassen.
|
||
x_bereinigt = trimws(sub("^[A-Za-z0-9]+[.\\\\]?\\s*", "", x))
|
||
treffer = which(tolower(VDS24_ITEMS$kurztext) == tolower(x_bereinigt))
|
||
if (length(treffer) == 1) {
|
||
return(list(nr = VDS24_ITEMS$nr[treffer], kurztext = VDS24_ITEMS$kurztext[treffer]))
|
||
}
|
||
NULL
|
||
}
|
||
|
||
# select_one-Felder zuerst ueber vds24_wahl_zu_item() aufloesen (siehe oben);
|
||
# nur falls ein labels-Attribut vorliegt (numerisch kodiertes Feld), zusaetzlich
|
||
# haven::as_factor() als Zwischenschritt versuchen. Nicht zuordenbare Rohwerte
|
||
# werden transparent mit Hinweis angezeigt statt stillschweigend verworfen
|
||
# (Abschnitt 7.6).
|
||
vds24_wahl_feld = function(zeile, feldname) {
|
||
if (!(feldname %in% names(zeile))) return(NA_character_)
|
||
roh = zeile[[feldname]][1]
|
||
if (is.null(roh) || (length(roh) == 1 && is.na(roh))) return(NA_character_)
|
||
|
||
hat_labels = !is.null(attr(zeile[[feldname]], "labels"))
|
||
kandidat = if (hat_labels) {
|
||
tryCatch(as.character(haven::as_factor(zeile[[feldname]]))[1], error = function(e) as.character(roh))
|
||
} else {
|
||
as.character(roh)
|
||
}
|
||
if (is.na(kandidat) || trimws(kandidat) == "" || trimws(kandidat) == "NA") return(NA_character_)
|
||
|
||
treffer = vds24_wahl_zu_item(kandidat)
|
||
if (!is.null(treffer)) {
|
||
return(paste0(treffer$nr, ". ", treffer$kurztext))
|
||
}
|
||
paste0(trimws(kandidat), " (Rohwert nicht zuordenbar)")
|
||
}
|
||
|
||
# Neutrales Profildiagramm ohne Farbzonen/Ampel-Klassifikation (Abschnitt 7.4) -
|
||
# fuer VDS24 gibt es keine Normwerte, an denen sich eine Einfaerbung fachlich
|
||
# begruenden liesse. Einheitliche Balkenfarbe in AKZENT_FARBE.
|
||
vds24_profil_plot = function(faktor_df) {
|
||
faktor_df$faktor = factor(faktor_df$faktor, levels = rev(FAKTOR_REIHENFOLGE))
|
||
faktor_df$y_balken = ifelse(is.na(faktor_df$profilwert), 0, faktor_df$profilwert)
|
||
faktor_df$beschriftung = ifelse(
|
||
is.na(faktor_df$mittelwert), "k. A.",
|
||
paste0(format(round(faktor_df$mittelwert, 1), nsmall = 1), " / 5")
|
||
)
|
||
|
||
ggplot(faktor_df, aes(x = faktor, y = y_balken)) +
|
||
geom_col(fill = AKZENT_FARBE, width = 0.6) +
|
||
geom_text(aes(label = beschriftung), hjust = -0.12, size = 4, color = "#333333") +
|
||
coord_flip() +
|
||
scale_y_continuous(limits = c(0, 3.6), breaks = 0:3) +
|
||
labs(x = NULL, y = "Profilwert (0–3), entspricht Faktor-Mittelwert × 3/5") +
|
||
theme_minimal(base_size = 12) +
|
||
theme(
|
||
panel.grid.minor = element_blank(),
|
||
axis.text.y = element_text(face = "bold", color = "#333333"),
|
||
plot.margin = margin(t = 5, r = 40, b = 5, l = 5)
|
||
)
|
||
}
|
||
|
||
|
||
# Datenaufbereitung ####
|
||
|
||
# Faktor-Reihenfolge fuer alle Anzeigen und das Profildiagramm (Abschnitt 5).
|
||
FAKTOR_REIHENFOLGE = c("BINDUNG", "SELBSTWERT", "AUTONOMIE", "ORIENTIERUNG", "IDENTITÄT", "HOMÖOSTASE")
|
||
|
||
# Statische Item-Faktor-Zuordnungstabelle, fest aus der Spezifikation
|
||
# uebernommen (nicht aus Item-Labels der Rohdaten zur Laufzeit abgeleitet) -
|
||
# vds24_h1..h7 haben in der xlsx kein eigenes Label, der Itemtext steht nur
|
||
# im _vm-Feld, daher hier vollstaendig hinterlegt.
|
||
VDS24_ITEMS = data.frame(
|
||
nr = c("1","2","3","4","5","6","7","8","9","10","11","12","13","14",
|
||
"H1","H2","H3","H4","H5","H6","H7"),
|
||
feld_rating = c("vds24_01","vds24_02","vds24_03","vds24_04","vds24_05","vds24_06",
|
||
"vds24_07","vds24_08","vds24_09","vds24_10","vds24_11","vds24_12",
|
||
"vds24_13","vds24_14","vds24_h1","vds24_h2","vds24_h3","vds24_h4",
|
||
"vds24_h5","vds24_h6","vds24_h7"),
|
||
feld_vm = c("vds24_01_vm","vds24_02_vm","vds24_03_vm","vds24_04_vm","vds24_05_vm",
|
||
"vds24_06_vm","vds24_07_vm","vds24_08_vm","vds24_09_vm","vds24_10_vm",
|
||
"vds24_11_vm","vds24_12_vm","vds24_13_vm","vds24_14_vm","vds24_h1_vm",
|
||
"vds24_h2_vm","vds24_h3_vm","vds24_h4_vm","vds24_h5_vm","vds24_h6_vm",
|
||
"vds24_h7_vm"),
|
||
itemtext = c(
|
||
"Mir fehlte Willkommensein",
|
||
"Mir fehlte Geborgenheit",
|
||
"Mir fehlte zuverlässiger Schutz",
|
||
"Mir fehlte Liebe",
|
||
"Mir fehlte Beachtung, Aufmerksamkeit",
|
||
"Mir fehlte Verständnis",
|
||
"Mir fehlte Wertschätzung, Bewunderung, Lob",
|
||
"Mir fehlte Selbst machen, selbst können",
|
||
"Mir fehlte Selbstbestimmung",
|
||
"Mir fehlte Genügend Grenzen",
|
||
"Mir fehlte Gefördert und gefordert werden",
|
||
"Mir fehlte ein hilfreiches Vorbild",
|
||
"Mir fehlte Intimität, Hingabe, kindliche Erotik",
|
||
"Mir fehlte ein Gegenüber",
|
||
"Eine ängstliche Bezugsperson war …",
|
||
"Eine bedrohliche Bezugsperson war …",
|
||
"Eine bedrohliche Außenwelt wurde mir vermittelt von …",
|
||
"Extrem wütend machte mich immer wieder …",
|
||
"Viel zu schwach als Gegenpol zum anderen Elternteil war …",
|
||
"Schuldgefühle machte mir immer wieder …",
|
||
"Missbraucht für seine eigenen Bedürfnisse hat mich …"
|
||
),
|
||
# Kurztexte wie im choices-Blatt der Formular-xlsx hinterlegt (Choice-Label
|
||
# der Rangfolge-Auswahlfelder) - kuerzer/anders formuliert als itemtext, wird
|
||
# ausschliesslich zur Aufloesung/Anzeige der Rangfolge-Auswahl genutzt
|
||
# (Abschnitt 7.6), nicht fuer die Itemliste je Faktor.
|
||
kurztext = c(
|
||
"Willkommensein",
|
||
"Geborgenheit",
|
||
"Zuverlässiger Schutz",
|
||
"Liebe",
|
||
"Beachtung, Aufmerksamkeit",
|
||
"Verständnis",
|
||
"Wertschätzung, Bewunderung, Lob",
|
||
"Selbst machen, selbst können",
|
||
"Selbstbestimmung",
|
||
"Genügend Grenzen",
|
||
"Gefördert und gefordert werden",
|
||
"Ein hilfreiches Vorbild",
|
||
"Intimität, Hingabe, kindliche Erotik",
|
||
"Ein Gegenüber",
|
||
"Ängstliche Bezugsperson",
|
||
"Bedrohliche Bezugsperson",
|
||
"Bedrohliche Außenwelt vermittelt",
|
||
"Extrem wütend gemacht",
|
||
"Zu schwacher Gegenpol zum anderen Elternteil",
|
||
"Schuldgefühle gemacht",
|
||
"Missbraucht für elterliche Bedürfnisse"
|
||
),
|
||
faktor = c("BINDUNG","BINDUNG","BINDUNG","BINDUNG",
|
||
"SELBSTWERT","SELBSTWERT","SELBSTWERT",
|
||
"AUTONOMIE","AUTONOMIE",
|
||
"ORIENTIERUNG","ORIENTIERUNG","ORIENTIERUNG",
|
||
"IDENTITÄT","IDENTITÄT",
|
||
"HOMÖOSTASE","HOMÖOSTASE","HOMÖOSTASE","HOMÖOSTASE","HOMÖOSTASE","HOMÖOSTASE","HOMÖOSTASE"),
|
||
stringsAsFactors = FALSE
|
||
)
|
||
|
||
# Kontrollsumme: 4 + 3 + 2 + 3 + 2 + 7 = 21 Items. Bei Abweichung sofort
|
||
# abbrechen statt still mit einer falschen Tabelle weiterzurechnen (das wuerde
|
||
# einen Copy-Paste-Fehler in der Struktur oben sonst verschleiern).
|
||
.vds24_kontrollsumme = nrow(VDS24_ITEMS)
|
||
if (.vds24_kontrollsumme != 21) {
|
||
stop("VDS24: Item-Faktor-Tabelle hat ", .vds24_kontrollsumme, " Zeilen, erwartet 21.")
|
||
}
|
||
.vds24_faktor_counts = table(factor(VDS24_ITEMS$faktor, levels = FAKTOR_REIHENFOLGE))
|
||
.vds24_counts_erwartet = setNames(c(4, 3, 2, 3, 2, 7), FAKTOR_REIHENFOLGE)
|
||
if (!identical(as.integer(.vds24_faktor_counts[FAKTOR_REIHENFOLGE]), as.integer(.vds24_counts_erwartet))) {
|
||
stop("VDS24: Itemanzahl je Faktor weicht von der Spezifikation ab. Bitte VDS24_ITEMS pruefen.")
|
||
}
|
||
|
||
# Rangfolge-/Reflexionsfelder (Abschnitt 7.6), rein qualitativ, fliessen nicht
|
||
# in Faktor-Rohwerte, -Mittelwerte oder das Profildiagramm ein. frage_wahl ist
|
||
# der tatsaechliche Fragetext aus dem survey-Blatt der Formular-xlsx (Spalte
|
||
# "label"), unveraendert bis auf die entfernte Ausfuellinstruktion "Bitte
|
||
# waehlen Sie das zutreffende Item aus:" - so liest sich Frage + Auswahl als
|
||
# ein zusammenhaengender Satz.
|
||
VDS24_RANG_STICHWORT_FRAGE = "Stichwort/kurze Beschreibung dazu:"
|
||
VDS24_RANG_GEFUEHL_FRAGE = "Mein Gefühl dabei ist:"
|
||
|
||
VDS24_RANG_FELDER = list(
|
||
list(titel = "Abschnitt A – 1. Priorität", frage_wahl = "Die wichtigste Frustration (Abschnitt A) war:",
|
||
wahl = "vds24_rang_a1_wahl", stichwort = "vds24_rang_a1_stichwort", gefuehl = "vds24_rang_a1_gefuehl"),
|
||
list(titel = "Abschnitt A – 2. Priorität", frage_wahl = "Die 2.wichtigste Frustration (Abschnitt A) war:",
|
||
wahl = "vds24_rang_a2_wahl", stichwort = "vds24_rang_a2_stichwort", gefuehl = "vds24_rang_a2_gefuehl"),
|
||
list(titel = "Abschnitt B – 1. Priorität", frage_wahl = "Die wichtigste Frustration (Abschnitt B) war:",
|
||
wahl = "vds24_rang_b1_wahl", stichwort = "vds24_rang_b1_stichwort", gefuehl = "vds24_rang_b1_gefuehl"),
|
||
list(titel = "Abschnitt B – 2. Priorität", frage_wahl = "Die 2.wichtigste Frustration (Abschnitt B) war:",
|
||
wahl = "vds24_rang_b2_wahl", stichwort = "vds24_rang_b2_stichwort", gefuehl = "vds24_rang_b2_gefuehl"),
|
||
list(titel = "Gesamt (Items 1–14) – wichtigste Frustration", frage_wahl = "Die wichtigste von Nr. 1 bis 14 war:",
|
||
wahl = "vds24_rang_b_gesamt_wahl", stichwort = "vds24_rang_b_gesamt_stichwort", gefuehl = NULL),
|
||
list(titel = "Abschnitt C – 1. Priorität", frage_wahl = "Die wichtigste Frustration (Abschnitt C) war:",
|
||
wahl = "vds24_rang_c1_wahl", stichwort = "vds24_rang_c1_stichwort", gefuehl = "vds24_rang_c1_gefuehl"),
|
||
list(titel = "Abschnitt C – 2. Priorität", frage_wahl = "Die 2.wichtigste Frustration (Abschnitt C) war:",
|
||
wahl = "vds24_rang_c2_wahl", stichwort = "vds24_rang_c2_stichwort", gefuehl = "vds24_rang_c2_gefuehl"),
|
||
list(titel = "Gesamt (Items 1–14 und H1–H7) – wichtigste Frustration", frage_wahl = "Die wichtigste von Nr. 1 bis 14 und H1 bis H7 war:",
|
||
wahl = "vds24_rang_c_gesamt_wahl", stichwort = "vds24_rang_c_gesamt_stichwort", gefuehl = 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; }
|
||
.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;
|
||
}
|
||
.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; }
|
||
.item-zeile {
|
||
display: flex; align-items: center; gap: 10px;
|
||
padding: 7px 0; border-bottom: 1px solid #F0F0F0;
|
||
}
|
||
.item-zeile:last-child { border-bottom: none; }
|
||
.item-nr { font-weight: 600; color: #8B2635; min-width: 30px; flex-shrink: 0; }
|
||
.item-text { flex: 1; color: #333; font-size: 0.92em; }
|
||
.item-vm {
|
||
font-size: 0.8em; color: #777; font-style: italic; white-space: nowrap; flex-shrink: 0;
|
||
}
|
||
.item-wert {
|
||
background: #8B2635; color: white; border-radius: 4px;
|
||
padding: 2px 9px; font-weight: 700; font-size: 0.82em;
|
||
white-space: nowrap; display: inline-block; flex-shrink: 0;
|
||
}
|
||
.faktor-tabelle { width: 100%; border-collapse: collapse; margin-top: 10px; }
|
||
.faktor-tabelle th, .faktor-tabelle td {
|
||
text-align: left; padding: 6px 10px; border-bottom: 1px solid #eee; font-size: 0.93em;
|
||
}
|
||
.faktor-tabelle th { color: #8B2635; border-bottom: 2px solid #8B2635; }
|
||
.qualitativ-hinweis {
|
||
font-size: 0.82em; color: #777; font-style: italic;
|
||
margin-bottom: 12px; border-bottom: 1px dashed #ddd; padding-bottom: 8px;
|
||
}
|
||
.freitext-block { margin-bottom: 14px; }
|
||
.freitext-frage { font-weight: 600; color: #8B2635; font-size: 0.95em; margin-bottom: 3px; }
|
||
.freitext-antwort { color: #333; font-size: 0.93em; white-space: pre-wrap; line-height: 1.5; }
|
||
.disclaimer-zeile {
|
||
font-size: 0.82em; color: #777; font-style: italic;
|
||
margin-top: 10px; border-top: 1px solid rgba(0,0,0,.1); padding-top: 8px;
|
||
}
|
||
"
|
||
|
||
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("VDS24 – Frustrierendes Elternverhalten in Kindheit und Jugend"),
|
||
tags$p("21 Ratingitems, 6 Bedürfnisbereiche, kein Summenscore, keine Normwerte")
|
||
),
|
||
|
||
div(class = "container-fluid",
|
||
|
||
div(class = "input-panel",
|
||
div(style = "min-width: 360px; white-space: nowrap;",
|
||
textInput("pseudonym",
|
||
label = tagList(
|
||
"Pseudonym",
|
||
tags$span(style = "font-weight: normal; font-style: italic; font-size: 0.78em; color: #888; margin-left: 4px; white-space: nowrap;",
|
||
"optional, hat Vorrang vor Chiffre")
|
||
),
|
||
placeholder = "optional", width = "340px")
|
||
),
|
||
div(style = "min-width: 200px;",
|
||
textInput("chiffre", label = "Patientenchiffre",
|
||
placeholder = "z.B. P000123", width = "100%")
|
||
),
|
||
actionButton("btn_suchen", "Auswerten", class = "btn btn-primary btn-laden"),
|
||
div(style = "margin-left: auto;",
|
||
downloadButton("download_word", "Word-Export (.docx)")
|
||
)
|
||
),
|
||
|
||
uiOutput("fehler_ui"),
|
||
uiOutput("warnung_ui"),
|
||
uiOutput("ergebnis_ui")
|
||
)
|
||
)
|
||
|
||
|
||
# Word-Export ####
|
||
|
||
erstelle_vds24_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_wert = fp_text(color = "white", bold = TRUE, shading.color = AKZENT_FARBE, font.size = 10)
|
||
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("VDS24 – Frustrierendes Elternverhalten in Kindheit und Jugend", fp_titel)))
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext("Chiffre: ", fp_label), ftext(erg$chiffre, fp_normal),
|
||
ftext(" Ausfülldatum: ", fp_label), ftext(erg$ausfuelldatum, 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"))
|
||
))
|
||
}
|
||
if (!is.null(erg$ausfuelldatum_warnung)) {
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(erg$ausfuelldatum_warnung, fp_text(font.size = 10, italic = TRUE, color = "#BF360C"))
|
||
))
|
||
}
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("Profil der 6 Bedürfnisbereiche", fp_abschnitt)))
|
||
|
||
profil_img = tempfile(fileext = ".png")
|
||
ggsave(profil_img, plot = vds24_profil_plot(erg$profil_df), width = 7, height = 4, dpi = 150, bg = "white")
|
||
doc = body_add_img(doc, src = profil_img, width = 6, height = 3.4)
|
||
file.remove(profil_img)
|
||
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
faktor_tabelle_df = data.frame(
|
||
Faktor = sapply(erg$faktor_ergebnisse, function(fe) fe$faktor),
|
||
Itemanzahl = sapply(erg$faktor_ergebnisse, function(fe) fe$n_gesamt),
|
||
Rohwertsumme = sapply(erg$faktor_ergebnisse, function(fe) if (is.na(fe$rohsumme)) "–" else fe$rohsumme),
|
||
`Mittelwert (0-5)` = sapply(erg$faktor_ergebnisse, function(fe) if (is.na(fe$mittelwert)) "–" else format(round(fe$mittelwert, 2), nsmall = 2)),
|
||
check.names = FALSE, stringsAsFactors = FALSE
|
||
)
|
||
doc = body_add_table(doc, faktor_tabelle_df)
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
for (fe in erg$faktor_ergebnisse) {
|
||
doc = body_add_fpar(doc, fpar(ftext(fe$faktor, fp_abschnitt)))
|
||
if (!is.na(fe$mittelwert) && fe$n_vorhanden < fe$n_gesamt) {
|
||
doc = body_add_fpar(doc, fpar(ftext(
|
||
paste0("Faktor-Score basiert auf ", fe$n_vorhanden, " von ", fe$n_gesamt, " Items."),
|
||
fp_text(font.size = 9.5, italic = TRUE, color = "#BF360C")
|
||
)))
|
||
}
|
||
for (r in seq_len(nrow(fe$items))) {
|
||
zeile = fe$items[r, ]
|
||
wert_txt = if (is.na(zeile$wert)) "k. A." else paste0(zeile$wert, " / 5")
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(paste0(zeile$nr, ". ", zeile$itemtext, " (", zeile$vm, ") "), fp_normal),
|
||
ftext(paste0(" ", wert_txt, " "), fp_wert)
|
||
))
|
||
}
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
}
|
||
|
||
doc = body_add_break(doc)
|
||
doc = body_add_fpar(doc, fpar(ftext("Reflexion und Priorisierung (qualitativ)", fp_abschnitt)))
|
||
doc = body_add_fpar(doc, fpar(ftext(
|
||
"Durch die Patientin/den Patienten angegeben, qualitative Zusatzinformation, kein Zahlenwert.",
|
||
fp_text(font.size = 9.5, italic = TRUE, color = "#777777")
|
||
)))
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
for (rb in erg$rang_bloecke) {
|
||
doc = body_add_fpar(doc, fpar(ftext(rb$titel, fp_label)))
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(paste0(rb$frage_wahl, " "), fp_label),
|
||
ftext(if (is.na(rb$wahl)) "keine Angabe" else rb$wahl, fp_normal)
|
||
))
|
||
if (!is.na(rb$stichwort)) {
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(paste0(VDS24_RANG_STICHWORT_FRAGE, " "), fp_label), ftext(rb$stichwort, fp_normal)
|
||
))
|
||
}
|
||
if (!is.na(rb$gefuehl)) {
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(paste0(VDS24_RANG_GEFUEHL_FRAGE, " "), fp_label), ftext(rb$gefuehl, fp_normal)
|
||
))
|
||
}
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
}
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("Abschlusstext", fp_label)))
|
||
doc = body_add_fpar(doc, fpar(ftext(
|
||
if (is.na(erg$abschluss_text)) "Keine Angabe." else erg$abschluss_text, fp_normal
|
||
)))
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext(VDS24_DISCLAIMER, fp_disclaimer)))
|
||
|
||
doc
|
||
}
|
||
|
||
|
||
# Server ####
|
||
|
||
server = function(input, output, session) {
|
||
|
||
observe({
|
||
query = parseQueryString(session$clientData$url_search)
|
||
if (!is.null(query$pseudonym) && nchar(trimws(query$pseudonym)) > 0) {
|
||
updateTextInput(session, "pseudonym", value = trimws(query$pseudonym))
|
||
}
|
||
})
|
||
|
||
observe({
|
||
query = parseQueryString(session$clientData$url_search)
|
||
if (!is.null(query$chiffre) && nchar(trimws(query$chiffre)) > 0) {
|
||
updateTextInput(session, "chiffre", value = toupper(trimws(query$chiffre)))
|
||
}
|
||
})
|
||
|
||
# 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 Chiffre oder Pseudonym eingeben."))
|
||
}
|
||
if (nchar(trimws(input$pseudonym)) == 0 && !grepl("^[A-Z][0-9]{6}$", chiffre)) {
|
||
return(list(error = "Ungültige Chiffre. Erwartet: ein Großbuchstabe + 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)))
|
||
|
||
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)
|
||
|
||
res_ps = tryCatch({
|
||
source(PFAD_PSEUDONYM_SKRIPT, local = FALSE)
|
||
if (nchar(trimws(input$pseudonym)) > 0) {
|
||
pw_treffer = pseudo[pseudo$pseudonym == trimws(input$pseudonym), ]
|
||
if (nrow(pw_treffer) > 0) chiffre = toupper(trimws(pw_treffer$chiffre[1]))
|
||
}
|
||
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_vds24", envir = .GlobalEnv)) {
|
||
return(list(error = "Objekt 'daten_vds24' nach dem Sourcen nicht gefunden. Bitte Download-Skript prüfen."))
|
||
}
|
||
if (!exists("pseudo", envir = .GlobalEnv)) {
|
||
return(list(error = "Objekt 'pseudo' nach dem Sourcen nicht gefunden. Bitte Pseudonym-Skript prüfen."))
|
||
}
|
||
|
||
daten = get("daten_vds24", 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, "' 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)
|
||
|
||
zeilen_index = which(daten$session %in% alle_session_ids)
|
||
if (length(zeilen_index) == 0) {
|
||
return(list(error = paste0(
|
||
"Kein VDS24-Datensatz für Chiffre '", chiffre, "' gefunden. ",
|
||
"(", length(alle_session_ids), " Pseudonym(e) geprüft)")))
|
||
}
|
||
|
||
# OFFENER PUNKT FUER ERSTEN TESTLAUF (Spezifikation Abschnitt 9 / 12.2):
|
||
# Name der Datumsspalte fuer das Ausfuelldatum ist nicht durch echte
|
||
# Exportdaten verifiziert. Kandidaten der Reihe nach probieren, sonst
|
||
# Sys.Date()-Fallback mit sichtbarer Warnung statt stiller Fehlannahme.
|
||
sortier_spalte = intersect(c("created", "ended", "expired"), names(daten))
|
||
sortier_spalte = if (length(sortier_spalte) > 0) sortier_spalte[1] else NA_character_
|
||
|
||
info_mehrere = NULL
|
||
if (length(zeilen_index) > 1) {
|
||
n = length(zeilen_index)
|
||
if (!is.na(sortier_spalte)) {
|
||
reihenfolge = order(daten[[sortier_spalte]][zeilen_index], decreasing = TRUE)
|
||
zeilen_index = zeilen_index[reihenfolge]
|
||
datum_neu = tryCatch(
|
||
format(as.POSIXct(daten[[sortier_spalte]][zeilen_index[1]]), "%d.%m.%Y %H:%M"),
|
||
error = function(e) "unbekanntes Datum"
|
||
)
|
||
} else {
|
||
datum_neu = "unbekanntes Datum (keine Datumsspalte gefunden)"
|
||
}
|
||
info_mehrere = paste0(
|
||
"Mehrere Ausfüllungen gefunden (", n, " Einträge). ",
|
||
"Angezeigt wird die neueste vom ", datum_neu, "."
|
||
)
|
||
}
|
||
zeile_idx = zeilen_index[1]
|
||
zeile = daten[zeile_idx, , drop = FALSE]
|
||
|
||
ausfuelldatum_warnung = NULL
|
||
ausfuelldatum = NA_character_
|
||
if (!is.na(sortier_spalte)) {
|
||
ausfuelldatum = tryCatch({
|
||
d = format(as.POSIXct(daten[[sortier_spalte]][zeile_idx]), "%d.%m.%Y")
|
||
if (is.na(d)) stop("NA")
|
||
d
|
||
}, error = function(e) NA_character_)
|
||
}
|
||
if (is.na(ausfuelldatum)) {
|
||
ausfuelldatum = format(Sys.Date(), "%d.%m.%Y")
|
||
ausfuelldatum_warnung = "Ausfülldatum konnte nicht aus den Daten ermittelt werden."
|
||
}
|
||
|
||
# --- Itemwerte (0-5) je Ratingfeld: item_score() wird auf die VOLLE Spalte
|
||
# angewandt, damit das labels-Attribut immer vom Original-Spaltenobjekt
|
||
# gelesen wird (Abschnitt 7.1), danach per Zeilenindex reduziert. ---
|
||
item_werte = sapply(VDS24_ITEMS$feld_rating, function(f) {
|
||
if (!(f %in% names(daten))) return(NA_real_)
|
||
werte_spalte = item_score(daten, f)
|
||
werte_spalte[zeile_idx]
|
||
})
|
||
names(item_werte) = VDS24_ITEMS$feld_rating
|
||
|
||
vm_werte = sapply(VDS24_ITEMS$feld_vm, function(f) {
|
||
vds24_vm_anzeige(vater_mutter_lesen(zeile, f))
|
||
})
|
||
names(vm_werte) = VDS24_ITEMS$feld_vm
|
||
|
||
faktor_ergebnisse = lapply(FAKTOR_REIHENFOLGE, function(fname) {
|
||
idx_zeilen = which(VDS24_ITEMS$faktor == fname)
|
||
werte = item_werte[VDS24_ITEMS$feld_rating[idx_zeilen]]
|
||
fs = vds24_faktor_auswerten(werte)
|
||
items_df = data.frame(
|
||
nr = VDS24_ITEMS$nr[idx_zeilen],
|
||
itemtext = VDS24_ITEMS$itemtext[idx_zeilen],
|
||
wert = unname(werte),
|
||
vm = unname(vm_werte[VDS24_ITEMS$feld_vm[idx_zeilen]]),
|
||
stringsAsFactors = FALSE
|
||
)
|
||
list(
|
||
faktor = fname, rohsumme = fs$rohsumme, mittelwert = fs$mittelwert,
|
||
n_vorhanden = fs$n_vorhanden, n_gesamt = fs$n_gesamt, items = items_df
|
||
)
|
||
})
|
||
names(faktor_ergebnisse) = FAKTOR_REIHENFOLGE
|
||
|
||
profil_df = data.frame(
|
||
faktor = FAKTOR_REIHENFOLGE,
|
||
mittelwert = sapply(faktor_ergebnisse, function(fe) fe$mittelwert),
|
||
stringsAsFactors = FALSE
|
||
)
|
||
profil_df$profilwert = vds24_profilwert(profil_df$mittelwert)
|
||
|
||
rang_bloecke = lapply(VDS24_RANG_FELDER, function(f) {
|
||
list(
|
||
titel = f$titel,
|
||
frage_wahl = f$frage_wahl,
|
||
wahl = vds24_wahl_feld(zeile, f$wahl),
|
||
stichwort = vds24_text_feld(zeile, f$stichwort),
|
||
gefuehl = if (is.null(f$gefuehl)) NA_character_ else vds24_text_feld(zeile, f$gefuehl)
|
||
)
|
||
})
|
||
|
||
abschluss_text = vds24_text_feld(zeile, "vds24_abschluss_text")
|
||
|
||
list(
|
||
chiffre = chiffre,
|
||
ausfuelldatum = ausfuelldatum,
|
||
ausfuelldatum_warnung = ausfuelldatum_warnung,
|
||
info_mehrere = info_mehrere,
|
||
faktor_ergebnisse = faktor_ergebnisse,
|
||
profil_df = profil_df,
|
||
rang_bloecke = rang_bloecke,
|
||
abschluss_text = abschluss_text,
|
||
error = NULL
|
||
)
|
||
})
|
||
|
||
output$fehler_ui = renderUI({
|
||
req(input$btn_suchen)
|
||
d = ergebnis_r()
|
||
if (!is.null(d$error)) div(class = "alert-fehler", d$error)
|
||
})
|
||
|
||
output$warnung_ui = renderUI({
|
||
req(input$btn_suchen)
|
||
d = ergebnis_r()
|
||
if (!is.null(d$error)) return(NULL)
|
||
tagList(
|
||
if (!is.null(d$info_mehrere)) div(class = "alert-warnung", d$info_mehrere),
|
||
if (!is.null(d$ausfuelldatum_warnung)) div(class = "alert-warnung", d$ausfuelldatum_warnung)
|
||
)
|
||
})
|
||
|
||
output$ergebnis_ui = renderUI({
|
||
req(input$btn_suchen)
|
||
d = ergebnis_r()
|
||
if (!is.null(d$error)) return(NULL)
|
||
|
||
faktor_tabelle_zeilen = lapply(d$faktor_ergebnisse, function(fe) {
|
||
tags$tr(
|
||
tags$td(fe$faktor),
|
||
tags$td(fe$n_gesamt),
|
||
tags$td(if (is.na(fe$rohsumme)) "–" else fe$rohsumme),
|
||
tags$td(if (is.na(fe$mittelwert)) "–" else format(round(fe$mittelwert, 2), nsmall = 2))
|
||
)
|
||
})
|
||
faktor_tabelle = tags$table(class = "faktor-tabelle",
|
||
tags$thead(tags$tr(
|
||
tags$th("Faktor"), tags$th("Itemanzahl"), tags$th("Rohwertsumme"), tags$th("Mittelwert (0–5)")
|
||
)),
|
||
tags$tbody(faktor_tabelle_zeilen)
|
||
)
|
||
|
||
item_karten = lapply(d$faktor_ergebnisse, function(fe) {
|
||
items_ui = lapply(seq_len(nrow(fe$items)), function(r) {
|
||
zeile = fe$items[r, ]
|
||
div(class = "item-zeile",
|
||
div(class = "item-nr", paste0(zeile$nr, ".")),
|
||
div(class = "item-text", zeile$itemtext),
|
||
span(class = "item-vm", zeile$vm),
|
||
span(class = "item-wert", if (is.na(zeile$wert)) "k. A." else paste0(zeile$wert, " / 5"))
|
||
)
|
||
})
|
||
div(class = "abschnitt-karte",
|
||
div(class = "abschnitt-titel", fe$faktor),
|
||
if (!is.na(fe$mittelwert) && fe$n_vorhanden < fe$n_gesamt)
|
||
div(class = "alert-warnung",
|
||
paste0("Unvollständig ausgefüllt: Faktor-Score basiert auf ", fe$n_vorhanden,
|
||
" von ", fe$n_gesamt, " Items.")),
|
||
div(items_ui)
|
||
)
|
||
})
|
||
|
||
rang_ui = lapply(d$rang_bloecke, function(rb) {
|
||
div(class = "freitext-block",
|
||
div(class = "freitext-frage", rb$titel),
|
||
div(class = "freitext-antwort",
|
||
tags$div(tags$strong(paste0(rb$frage_wahl, " ")), if (is.na(rb$wahl)) "keine Angabe" else rb$wahl),
|
||
if (!is.na(rb$stichwort)) tags$div(tags$strong(paste0(VDS24_RANG_STICHWORT_FRAGE, " ")), rb$stichwort),
|
||
if (!is.na(rb$gefuehl)) tags$div(tags$strong(paste0(VDS24_RANG_GEFUEHL_FRAGE, " ")), rb$gefuehl)
|
||
)
|
||
)
|
||
})
|
||
|
||
reflexion_karte = div(class = "abschnitt-karte",
|
||
div(class = "abschnitt-titel", "Reflexion und Priorisierung (durch die Patientin/den Patienten, qualitativ)"),
|
||
div(class = "qualitativ-hinweis", "Qualitative Zusatzinformation, kein Zahlenwert, fließt nicht in Faktorwerte ein."),
|
||
rang_ui,
|
||
tags$hr(),
|
||
div(class = "freitext-block",
|
||
div(class = "freitext-frage", "Abschlusstext (Auswirkung auf Persönlichkeit/Beziehungsgestaltung)"),
|
||
div(class = "freitext-antwort",
|
||
if (is.na(d$abschluss_text)) "Keine Angabe." else d$abschluss_text)
|
||
)
|
||
)
|
||
|
||
tagList(
|
||
div(class = "abschnitt-karte",
|
||
div(class = "meta-block",
|
||
tags$strong("Chiffre: "), d$chiffre,
|
||
tags$span(" | ", style = "color:#ccc;"),
|
||
tags$strong("Ausfülldatum: "), d$ausfuelldatum
|
||
)
|
||
),
|
||
div(class = "abschnitt-karte",
|
||
div(class = "abschnitt-titel", "Profil der 6 Bedürfnisbereiche"),
|
||
plotOutput("profil_plot", height = "340px"),
|
||
tags$hr(),
|
||
faktor_tabelle
|
||
),
|
||
item_karten,
|
||
reflexion_karte,
|
||
div(class = "disclaimer-zeile", VDS24_DISCLAIMER)
|
||
)
|
||
})
|
||
|
||
output$profil_plot = renderPlot({
|
||
req(input$btn_suchen)
|
||
d = ergebnis_r()
|
||
req(is.null(d$error))
|
||
vds24_profil_plot(d$profil_df)
|
||
}, bg = "transparent")
|
||
|
||
output$download_word = downloadHandler(
|
||
filename = function() {
|
||
d = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||
chiffre_esc = if (is.list(d) && is.null(d$error) && nchar(d$chiffre) > 0)
|
||
gsub("[^A-Za-z0-9_-]", "_", d$chiffre) else "export"
|
||
datum_fn = if (is.list(d) && is.null(d$error) && !is.null(d$ausfuelldatum)) {
|
||
tryCatch(
|
||
format(as.Date(d$ausfuelldatum, "%d.%m.%Y"), "%Y%m%d"),
|
||
error = function(e) format(Sys.Date(), "%Y%m%d")
|
||
)
|
||
} else {
|
||
format(Sys.Date(), "%Y%m%d")
|
||
}
|
||
paste0("VDS24_", chiffre_esc, "_", datum_fn, ".docx")
|
||
},
|
||
content = function(file) {
|
||
d = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||
daten_ok = is.list(d) && is.null(d$error)
|
||
if (!daten_ok) {
|
||
doc = read_docx()
|
||
doc = body_add_par(doc,
|
||
"Kein Datensatz geladen. Bitte zuerst Chiffre oder Pseudonym eingeben und 'Auswerten' klicken.",
|
||
style = "Normal")
|
||
print(doc, target = file)
|
||
return()
|
||
}
|
||
doc = tryCatch(
|
||
erstelle_vds24_docx(d),
|
||
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)
|