1622 lines
69 KiB
R
1622 lines
69 KiB
R
# Präambel ####
|
||
|
||
AKZENT_FARBE = "#8B2635"
|
||
|
||
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_dsf.R" # liefert beim Sourcen: daten_dsf
|
||
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R" # liefert beim Sourcen: pseudo
|
||
|
||
DSF_DISCLAIMER = paste0(
|
||
"Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
|
||
"keine klinische Diagnose. Die Interpretation obliegt der behandelnden Person. ",
|
||
"Der Hinweis zu Frage 18 (Suizidalitaet) ist ein Screeningresultat und keine ",
|
||
"automatisierte Risikobewertung."
|
||
)
|
||
|
||
# Badge-Farben 0-3, analog zum BDI-II-Muster (gruen -> dunkelrot), fuer die
|
||
# 14 HADS-Einzelitems.
|
||
DSF_BADGE_FARBEN = c("0" = "#4CAF50", "1" = "#F48FB1", "2" = "#EF5350", "3" = "#B71C1C")
|
||
DSF_BADGE_TEXT_FARBEN = c("0" = "white", "1" = "#333333", "2" = "white", "3" = "white")
|
||
|
||
# Koerperschema-Hintergrundbild (Vorder-/Rueckansicht). Wird als base64-Data-URI
|
||
# direkt in die Seite eingebettet (nicht als www/-Asset ausgeliefert), damit die
|
||
# Anzeige unabhaengig von Deployment-Details funktioniert (Reverse-Proxy,
|
||
# abweichendes Arbeitsverzeichnis o.ae. koennen Shinys automatisches
|
||
# www/-Ausliefern unterbrechen). Derselbe Pfad wird fuer den Word-Export ueber
|
||
# png::readPNG() erneut eingelesen.
|
||
PFAD_KOERPERSCHEMA_BILD = file.path("www", "koerperschema.png")
|
||
|
||
# Rastergroesse des Koerperschema-Eingabewidgets (aus dem paingrid_widget-
|
||
# Notizfeld der xlsx uebernommen: 60 Zeilen x 48 Spalten, Zell-ID-Format
|
||
# "r<ZZ>_c<SS>"). Dient nur als Fallback, falls paingrid_data selbst keine
|
||
# grid_rows/grid_cols-Angabe enthaelt.
|
||
DSF_PAINGRID_ZEILEN_STANDARD = 60
|
||
DSF_PAINGRID_SPALTEN_STANDARD = 48
|
||
|
||
library(shiny)
|
||
library(dplyr)
|
||
library(ggplot2)
|
||
library(haven)
|
||
library(officer)
|
||
library(DBI)
|
||
library(RSQLite)
|
||
library(jsonlite)
|
||
library(png)
|
||
|
||
|
||
# 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)
|
||
PFAD_KOERPERSCHEMA_BILD = normalizePath(absPath(PFAD_KOERPERSCHEMA_BILD), mustWork = FALSE)
|
||
|
||
# Einmalig beim App-Start als base64-Data-URI eingelesen (siehe Kommentar bei
|
||
# PFAD_KOERPERSCHEMA_BILD in der Praeambel). NA, falls die Datei fehlt - wird
|
||
# beim Rendern abgefangen statt die App abstuerzen zu lassen.
|
||
DSF_KOERPERSCHEMA_DATA_URI = tryCatch({
|
||
roh = readBin(PFAD_KOERPERSCHEMA_BILD, "raw", file.info(PFAD_KOERPERSCHEMA_BILD)$size)
|
||
paste0("data:image/png;base64,", jsonlite::base64_enc(roh))
|
||
}, error = function(e) NA_character_)
|
||
|
||
# Kandidaten in Prioritaetsreihenfolge - der exakte Zeitstempel-Spaltenname in
|
||
# daten_dsf war ohne einen echten Testexport nicht verifizierbar (siehe Punkt 5
|
||
# der unverifizierten Annahmen im Build-Prompt).
|
||
DSF_DATUM_KANDIDATEN = c("created", "modified", "ended", "expired")
|
||
|
||
|
||
# Helper ####
|
||
|
||
# Wandelt eine Hex-Farbe (z.B. AKZENT_FARBE) in einen rgba()-CSS-String um,
|
||
# damit die Koerperschema-Markierungen automatisch der Akzentfarbe folgen.
|
||
dsf_hex_zu_rgba = function(hex, alpha) {
|
||
hex = sub("^#", "", hex)
|
||
r = strtoi(substr(hex, 1, 2), 16L)
|
||
g = strtoi(substr(hex, 3, 4), 16L)
|
||
b = strtoi(substr(hex, 5, 6), 16L)
|
||
sprintf("rgba(%d,%d,%d,%s)", r, g, b, alpha)
|
||
}
|
||
|
||
# Linear zwischen zwei Hex-Farben interpolieren (frac 0 = hex1, 1 = hex2).
|
||
dsf_hex_interpolieren = function(hex1, hex2, frac) {
|
||
c1 = grDevices::col2rgb(hex1)
|
||
c2 = grDevices::col2rgb(hex2)
|
||
mix = round(c1 + (c2 - c1) * frac)
|
||
grDevices::rgb(mix[1, 1] / 255, mix[2, 1] / 255, mix[3, 1] / 255)
|
||
}
|
||
|
||
# Badge-Farbe fuer einen quantitativen Wert: bei bekanntem Wertebereich ein
|
||
# Helligkeitsverlauf der Akzentfarbe (hell = niedrig, kraeftig = hoch) - KEIN
|
||
# gruen-rotes Ampelschema, da die klinische Richtung ("hoch = schlechter?")
|
||
# nicht fuer jedes Item dokumentiert ist (z.B. sind hohe FW7-Werte positiv).
|
||
# Ohne bekannten Bereich (offene Zahlenfelder wie Alter/Anzahl) ein neutraler,
|
||
# nicht abgestufter Badge in der Akzentfarbe.
|
||
dsf_wert_badge_farbe = function(wert_num, bereich_min, bereich_max) {
|
||
if (is.na(bereich_min) || is.na(bereich_max) || bereich_max <= bereich_min) {
|
||
return(list(bg = AKZENT_FARBE, fg = "white"))
|
||
}
|
||
frac = max(0, min(1, (wert_num - bereich_min) / (bereich_max - bereich_min)))
|
||
hell = dsf_hex_interpolieren("#FFFFFF", AKZENT_FARBE, 0.20)
|
||
bg = dsf_hex_interpolieren(hell, AKZENT_FARBE, frac)
|
||
fg = if (frac > 0.55) "white" else "#333333"
|
||
list(bg = bg, fg = fg)
|
||
}
|
||
|
||
# Baut eine generische Item-Zeile fuer die Bildschirmanzeige: quantitative
|
||
# Werte (wert_num nicht NA) als farbiger Badge (siehe dsf_wert_badge_farbe),
|
||
# qualitative Antworten weiterhin als schlichter Text - "it" ist das Ergebnis
|
||
# von dsf_render_item().
|
||
dsf_item_zeile_ui = function(it) {
|
||
wert_ui = if (!is.na(it$wert_num)) {
|
||
badge = dsf_wert_badge_farbe(it$wert_num, it$bereich_min, it$bereich_max)
|
||
bereich_txt = if (!is.na(it$bereich_min))
|
||
tags$span(style = "color:#999; font-size:0.8em; margin-left:6px;",
|
||
paste0("(", it$bereich_min, "-", it$bereich_max, ")")) else NULL
|
||
tagList(
|
||
tags$span(
|
||
title = it$text,
|
||
style = paste0(
|
||
"display:inline-block; border-radius:4px; padding:2px 9px; font-weight:700;",
|
||
"font-size:0.85em; background:", badge$bg, "; color:", badge$fg, ";"
|
||
),
|
||
format(it$wert_num, trim = TRUE)
|
||
),
|
||
bereich_txt
|
||
)
|
||
} else {
|
||
span(class = "item-wert", it$text)
|
||
}
|
||
|
||
div(class = "item-zeile",
|
||
div(class = "item-text", it$label),
|
||
wert_ui
|
||
)
|
||
}
|
||
|
||
# Word-Export-Pendant zu dsf_item_zeile_ui: quantitative Werte als farbig
|
||
# hinterlegtes ftext() (shading.color statt CSS-Badge), qualitative Antworten
|
||
# als schlichter Text. fp_label ist das Formatprofil fuer das Label-ftext.
|
||
dsf_item_fpar_docx = function(it, fp_label) {
|
||
fp_normal = fp_text(font.size = 11)
|
||
if (!is.na(it$wert_num)) {
|
||
badge = dsf_wert_badge_farbe(it$wert_num, it$bereich_min, it$bereich_max)
|
||
bereich_txt = if (!is.na(it$bereich_min)) paste0(" (", it$bereich_min, "-", it$bereich_max, ")") else ""
|
||
fp_badge = fp_text(bold = TRUE, font.size = 10, color = badge$fg, shading.color = badge$bg)
|
||
fpar(
|
||
ftext(paste0(it$label, ": "), fp_label),
|
||
ftext(paste0(" ", format(it$wert_num, trim = TRUE), " "), fp_badge),
|
||
ftext(bereich_txt, fp_text(font.size = 9, color = "#999999"))
|
||
)
|
||
} else {
|
||
fpar(ftext(paste0(it$label, ": "), fp_label), ftext(it$text, fp_normal))
|
||
}
|
||
}
|
||
|
||
# Parst paingrid_data (JSON: {"grid_rows":60,"grid_cols":48,"selected_cells":
|
||
# ["r05_c12", ...]}) - Format aus dem paingrid_widget-Notizfeld der xlsx.
|
||
# Liefert grid_rows/grid_cols (mit Fallback auf die Standardgroesse) und die
|
||
# markierten Zellen als data.frame(row, col).
|
||
dsf_parse_paingrid_data = function(json_text) {
|
||
leer = list(grid_rows = DSF_PAINGRID_ZEILEN_STANDARD,
|
||
grid_cols = DSF_PAINGRID_SPALTEN_STANDARD,
|
||
zellen = data.frame(row = integer(0), col = integer(0)))
|
||
if (is.null(json_text) || is.na(json_text) || nchar(trimws(json_text)) == 0) return(leer)
|
||
|
||
payload = tryCatch(jsonlite::fromJSON(json_text), error = function(e) NULL)
|
||
if (is.null(payload)) return(leer)
|
||
|
||
grid_rows = if (!is.null(payload$grid_rows) && !is.na(payload$grid_rows))
|
||
as.integer(payload$grid_rows) else DSF_PAINGRID_ZEILEN_STANDARD
|
||
grid_cols = if (!is.null(payload$grid_cols) && !is.na(payload$grid_cols))
|
||
as.integer(payload$grid_cols) else DSF_PAINGRID_SPALTEN_STANDARD
|
||
|
||
zellen_ids = payload$selected_cells
|
||
if (is.null(zellen_ids) || length(zellen_ids) == 0) {
|
||
return(list(grid_rows = grid_rows, grid_cols = grid_cols,
|
||
zellen = data.frame(row = integer(0), col = integer(0))))
|
||
}
|
||
|
||
m = regmatches(zellen_ids, regexec("^r([0-9]+)_c([0-9]+)$", zellen_ids))
|
||
zellen = do.call(rbind, lapply(m, function(x) {
|
||
if (length(x) != 3) return(NULL)
|
||
data.frame(row = as.integer(x[2]), col = as.integer(x[3]))
|
||
}))
|
||
if (is.null(zellen)) zellen = data.frame(row = integer(0), col = integer(0))
|
||
|
||
list(grid_rows = grid_rows, grid_cols = grid_cols, zellen = zellen)
|
||
}
|
||
|
||
# Entfernt eingebettetes HTML-Markup aus Anker-/Labeltexten (z.B. die
|
||
# <img>-Piktogramme bei dsf_08a: "<div><img src=... alt='Text'><div>Text</div></div>").
|
||
# Tags werden vollstaendig entfernt (inkl. alt-Attribut, das als Tag-Attribut
|
||
# und nicht als Textknoten zaehlt) - uebrig bleibt nur der sichtbare Text.
|
||
dsf_strip_html = function(txt) {
|
||
if (is.null(txt) || length(txt) == 0 || is.na(txt[1])) return(NA_character_)
|
||
x = as.character(txt[1])
|
||
if (!grepl("<", x, fixed = TRUE)) return(x)
|
||
x = gsub("<[^>]+>", " ", x)
|
||
x = gsub(" ", " ", x, fixed = TRUE)
|
||
x = gsub("&", "&", x, fixed = TRUE)
|
||
trimws(gsub("\\s+", " ", x))
|
||
}
|
||
|
||
# Entfernt formr-Nummerierungsartefakte und Markdown-Reste aus dem label-Attribut
|
||
# (z.B. "17. " oder "01) ", sowie Markdown-Sternchen/Escapes und HTML-Markup).
|
||
dsf_clean_label = function(text) {
|
||
if (is.null(text) || length(text) == 0 || is.na(text[1])) return(NA_character_)
|
||
txt = dsf_strip_html(text)
|
||
txt = trimws(txt)
|
||
txt = gsub("\\*\\*", "", txt)
|
||
txt = sub("^\\d+\\\\?[.)]\\s*", "", txt)
|
||
txt = gsub("\\\\([.)(_*+~`>#-])", "\\1", txt)
|
||
trimws(txt)
|
||
}
|
||
|
||
# Normalisiert Ankertext fuer den Vergleich (Gross-/Kleinschreibung, Umlaute,
|
||
# Satzzeichen, doppelte Leerzeichen) - Grundlage fuer JEDEN Recode in dieser App.
|
||
# Es wird nie ueber den rohen numerischen Code recodiert.
|
||
normalisiere_text = function(x) {
|
||
if (is.null(x) || length(x) == 0 || is.na(x[1])) return(NA_character_)
|
||
txt = tolower(trimws(as.character(x[1])))
|
||
txt = gsub("ä", "ae", txt)
|
||
txt = gsub("ö", "oe", txt)
|
||
txt = gsub("ü", "ue", txt)
|
||
txt = gsub("ß", "ss", txt)
|
||
txt = gsub("[^a-z0-9, ]", "", txt)
|
||
trimws(gsub("\\s+", " ", txt))
|
||
}
|
||
|
||
# Loest den Ankertext ueber das labels-Attribut der ORIGINAL-Spalte auf (vor
|
||
# Subsetting gelesen). Ohne labels-Attribut wird der Rohwert als Text zurueck-
|
||
# gegeben (Fallback fuer unlabelled numerische Spalten).
|
||
# Vergleich ueber as.character(unclass(...)), NIE ueber as.numeric(): formr
|
||
# exportiert mc-Items teils als chr+lbl (Rohwert ist eine Zeichenkette, nicht
|
||
# konvertierbar), teils als dbl+lbl - unclass() entfernt vorher die
|
||
# haven_labelled-Klasse, damit as.character() nicht ueber vctrs/haven-eigene
|
||
# Konvertierungsmethoden stolpert.
|
||
dsf_anker_text = function(original_col, wert) {
|
||
if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) return(NA_character_)
|
||
lbl_attr = attr(original_col, "labels")
|
||
wert_roh = unclass(wert)[1]
|
||
if (!is.null(lbl_attr) && length(lbl_attr) > 0) {
|
||
pos = which(as.character(unclass(lbl_attr)) == as.character(wert_roh))
|
||
if (length(pos) > 0) return(dsf_strip_html(names(lbl_attr)[pos[1]]))
|
||
}
|
||
as.character(wert_roh)
|
||
}
|
||
|
||
# Loest mehrfachkodierte Ankertexte auf (mc_multiple-Items, deren Rohwert eine
|
||
# durch Komma/Semikolon getrennte Codeliste ist, z.B. "1,3,5" statt eines
|
||
# einzelnen Codes). Jeder Teilcode wird einzeln ueber das labels-Attribut
|
||
# aufgeloest; nicht auflösbare Teile werden roh belassen statt stillschweigend
|
||
# verworfen. Liefert NA, wenn kein labels-Attribut vorhanden oder nichts zum
|
||
# Aufloesen uebrig bleibt.
|
||
dsf_multi_anker_text = function(original_col, wert) {
|
||
lbl_attr = attr(original_col, "labels")
|
||
if (is.null(lbl_attr) || length(lbl_attr) == 0) return(NA_character_)
|
||
wert_roh = as.character(unclass(wert)[1])
|
||
wert_bereinigt = gsub("[\\[\\]\"]", "", wert_roh)
|
||
teile = trimws(strsplit(wert_bereinigt, "[,;]")[[1]])
|
||
teile = teile[nchar(teile) > 0]
|
||
if (length(teile) == 0) return(NA_character_)
|
||
aufgeloest = sapply(teile, function(code) {
|
||
pos = which(as.character(unclass(lbl_attr)) == code)
|
||
if (length(pos) > 0) dsf_strip_html(names(lbl_attr)[pos[1]]) else code
|
||
})
|
||
paste(aufgeloest, collapse = ", ")
|
||
}
|
||
|
||
# Manche mc-Items kodieren einen quantitativen Abstufungsgrad direkt im
|
||
# Ankertext (z.B. SBL: "3 – trifft genau zu" .. "0 – trifft nicht zu", oder
|
||
# die Beeintraechtigungs-Unterfrage bei Komorbiditaeten: "3 – starke" ..
|
||
# "0 – keine"). Wird dieses Muster erkannt, bekommt das Item trotz mc-Typ
|
||
# einen quantitativen Werte-Badge - der Wertebereich wird aus ALLEN Choices
|
||
# desselben Items abgeleitet (labels-Attribut), nicht hartkodiert.
|
||
DSF_ANKER_ZAHL_MUSTER = "^([0-9]+)\\s*[-–—]"
|
||
|
||
dsf_anker_zahl_bereich = function(original_col, anker_text) {
|
||
leer = list(wert_num = NA_real_, bereich_min = NA_real_, bereich_max = NA_real_)
|
||
if (is.na(anker_text)) return(leer)
|
||
m_aktuell = regmatches(anker_text, regexpr(DSF_ANKER_ZAHL_MUSTER, anker_text))
|
||
if (length(m_aktuell) == 0) return(leer)
|
||
wert_num = as.numeric(sub(DSF_ANKER_ZAHL_MUSTER, "\\1", m_aktuell))
|
||
|
||
lbl_attr = attr(original_col, "labels")
|
||
if (is.null(lbl_attr) || length(lbl_attr) == 0) {
|
||
return(list(wert_num = wert_num, bereich_min = NA_real_, bereich_max = NA_real_))
|
||
}
|
||
alle_texte = sapply(names(lbl_attr), dsf_strip_html)
|
||
treffer = regmatches(alle_texte, regexpr(DSF_ANKER_ZAHL_MUSTER, alle_texte))
|
||
alle_zahlen = suppressWarnings(as.numeric(sub(DSF_ANKER_ZAHL_MUSTER, "\\1", treffer)))
|
||
alle_zahlen = alle_zahlen[!is.na(alle_zahlen)]
|
||
if (length(alle_zahlen) < 2) {
|
||
return(list(wert_num = wert_num, bereich_min = NA_real_, bereich_max = NA_real_))
|
||
}
|
||
list(wert_num = wert_num, bereich_min = min(alle_zahlen), bereich_max = max(alle_zahlen))
|
||
}
|
||
|
||
# Fuer mc-Items OHNE selbstdeklarierte Zahl im Ankertext (z.B. SF-12, Modul A:
|
||
# "ausgezeichnet"/"sehr gut"/... ohne Ziffernpraefix) wird die Position der
|
||
# Antwortoption in der xlsx (choice1=1, choice2=2, ...) als quantitativer Wert
|
||
# verwendet - transkribiert in DSF_ORDINAL_ANKER_ITEMS, NIE aus dem Rohwert
|
||
# der Daten abgeleitet (gleiche Ankertext-Prinzip wie bei HADS). Die Werte
|
||
# druecken nur die Reihenfolge der Antwortskala aus, keine Wertung
|
||
# "hoch = schlechter" (siehe dsf_wert_badge_farbe: neutraler Verlauf, kein
|
||
# Ampelschema, da die klinische Richtung nicht fuer jedes Item bekannt ist).
|
||
dsf_ordinal_wert = function(var, anker_text) {
|
||
leer = list(wert_num = NA_real_, bereich_min = NA_real_, bereich_max = NA_real_)
|
||
tabelle = DSF_ORDINAL_ANKER_ITEMS[[var]]
|
||
if (is.null(tabelle) || is.na(anker_text)) return(leer)
|
||
norm = normalisiere_text(anker_text)
|
||
for (key in names(tabelle)) {
|
||
if (identical(normalisiere_text(key), norm)) {
|
||
return(list(wert_num = as.numeric(tabelle[[key]]),
|
||
bereich_min = min(tabelle), bereich_max = max(tabelle)))
|
||
}
|
||
}
|
||
leer
|
||
}
|
||
|
||
# Kombiniert beide Quellen fuer einen quantitativen mc-Wert: zuerst die
|
||
# transkribierte Ordinaltabelle (SF-12/Modul A), dann das selbstdeklarierte
|
||
# Zahlenpraefix im Ankertext (SBL/Komorbiditaeten-Beeintraechtigung).
|
||
dsf_mc_wert_info = function(var, original_col, anker_text) {
|
||
info = dsf_ordinal_wert(var, anker_text)
|
||
if (!is.na(info$wert_num)) return(info)
|
||
dsf_anker_zahl_bereich(original_col, anker_text)
|
||
}
|
||
|
||
# Ordnet einem HADS-Item ueber den (normalisierten) Ankertext den Score 0-3 zu.
|
||
# anker_tabelle: benannter Vektor "ankertext" = score, siehe DSF_HADS_ITEMS.
|
||
dsf_hads_item_score = function(original_col, wert, anker_tabelle) {
|
||
anker_text = dsf_anker_text(original_col, wert)
|
||
if (is.na(anker_text)) return(list(score = NA_integer_, anker_text = NA_character_))
|
||
norm = normalisiere_text(anker_text)
|
||
for (key in names(anker_tabelle)) {
|
||
if (identical(normalisiere_text(key), norm)) {
|
||
return(list(score = as.integer(anker_tabelle[[key]]), anker_text = anker_text))
|
||
}
|
||
}
|
||
list(score = NA_integer_, anker_text = anker_text)
|
||
}
|
||
|
||
# Ein Slot eines Wiederholungsblocks gilt als "ausgefuellt", wenn sein Leitfeld
|
||
# nicht leer/NA ist. Reine Lesbarkeits-Entscheidung (siehe Abschnitt 2 des
|
||
# Build-Prompts), keine klinische Bewertung.
|
||
dsf_ist_ausgefuellt = function(wert) {
|
||
if (is.null(wert) || length(wert) == 0) return(FALSE)
|
||
w = wert[1]
|
||
if (is.na(w)) return(FALSE)
|
||
if (is.character(w)) return(nchar(trimws(w)) > 0)
|
||
if (is.logical(w)) return(isTRUE(w))
|
||
TRUE
|
||
}
|
||
|
||
# Generischer Ein-Spalten-Renderer (Abschnitt 5 des Build-Prompts): liest Typ/
|
||
# Attribute der Spalte und liefert list(label, text, wert_num, bereich_min,
|
||
# bereich_max) oder NULL, wenn das Feld leer ist und deshalb uebersprungen
|
||
# werden soll. wert_num/bereich_* sind bei nicht-numerischen (qualitativen)
|
||
# Antworten NA - darueber entscheiden die UI/Word-Renderer, ob ein farbiger
|
||
# Werte-Badge gezeigt wird (nur fuer echte Zahlenwerte, nie fuer Ankertexte).
|
||
# - haven_labelled (mc-Items): ueber Ankertext, nie ueber Rohwert.
|
||
# - logical (check-Items): nur anzeigen, wenn TRUE.
|
||
# - numerisch (range_ticks/number): Rohwert, mit bekanntem Wertebereich
|
||
# (DSF_WERTEBEREICHE) falls vorhanden, sonst ohne Bereichsangabe.
|
||
# - character (text/textarea): Rohtext, leer/NA wird uebersprungen.
|
||
# check-Items, die formr evtl. als 0/1-numerisch statt logical exportiert,
|
||
# werden hier NICHT gesondert erkannt (siehe unverifizierte Annahme Punkt 2 im
|
||
# Build-Prompt) - sie erscheinen dann als gewoehnlicher Zahlenwert mit Badge.
|
||
dsf_render_item = function(daten, zeile, var) {
|
||
leer_ergebnis = list(wert_num = NA_real_, bereich_min = NA_real_, bereich_max = NA_real_)
|
||
if (!(var %in% names(daten))) return(NULL)
|
||
spalte_orig = daten[[var]]
|
||
wert = zeile[[var]]
|
||
wert0 = if (length(wert) > 0) wert[1] else NA
|
||
|
||
label_roh = attr(spalte_orig, "label")
|
||
label = if (!is.null(label_roh) && !is.na(label_roh)) dsf_clean_label(label_roh) else var
|
||
|
||
lbl_attr = attr(spalte_orig, "labels")
|
||
if (!is.null(lbl_attr) && length(lbl_attr) > 0) {
|
||
if (is.na(wert0)) return(NULL)
|
||
text = dsf_anker_text(spalte_orig, wert0)
|
||
|
||
# mc_multiple-Items koennen als durch Komma/Semikolon getrennte Codeliste
|
||
# exportiert werden (Einzelwert-Aufloesung oben schlaegt dann fehl und
|
||
# liefert den unveraenderten Rohwert zurueck) - in dem Fall jeden Teilcode
|
||
# einzeln aufloesen statt rohe Ziffern anzuzeigen.
|
||
wert_roh_chr = as.character(unclass(wert0))
|
||
if (identical(text, wert_roh_chr) && grepl("[,;]", wert_roh_chr)) {
|
||
multi = dsf_multi_anker_text(spalte_orig, wert0)
|
||
if (!is.na(multi)) text = multi
|
||
}
|
||
|
||
anker_final = if (is.na(text)) as.character(wert0) else text
|
||
zahl_info = dsf_mc_wert_info(var, spalte_orig, anker_final)
|
||
return(list(label = label, text = anker_final,
|
||
wert_num = zahl_info$wert_num,
|
||
bereich_min = zahl_info$bereich_min, bereich_max = zahl_info$bereich_max))
|
||
}
|
||
|
||
if (is.logical(wert0)) {
|
||
if (is.na(wert0) || !isTRUE(wert0)) return(NULL)
|
||
return(c(list(label = label, text = "Ja"), leer_ergebnis))
|
||
}
|
||
|
||
if (is.numeric(wert0)) {
|
||
if (is.na(wert0)) return(NULL)
|
||
kontext = dsf_nrs_kontext(var)
|
||
bereich = DSF_WERTEBEREICHE[[var]]
|
||
text = if (!is.null(kontext)) paste0(wert0, " von 0-10 (0 = ", kontext$min, ", 10 = ", kontext$max, ")")
|
||
else as.character(wert0)
|
||
return(list(
|
||
label = label, text = text, wert_num = as.numeric(wert0),
|
||
bereich_min = if (!is.null(bereich)) bereich[1] else NA_real_,
|
||
bereich_max = if (!is.null(bereich)) bereich[2] else NA_real_
|
||
))
|
||
}
|
||
|
||
txt = trimws(as.character(wert0))
|
||
if (is.na(wert0) || nchar(txt) == 0) return(NULL)
|
||
c(list(label = label, text = txt), leer_ergebnis)
|
||
}
|
||
|
||
# NRS-Endpunkt-Kontext nur fuer die beiden Items, deren Ankertext im Build-
|
||
# Prompt woertlich vorgegeben ist (Schmerzstaerke/Beeintraechtigung, Frage 11/12).
|
||
# Fuer alle anderen numerischen Items (FW7, Modul A) wird kein Endpunkttext
|
||
# erfunden, da er nur aus der xlsx selbst stammen duerfte (dort nicht verfuegbar).
|
||
dsf_nrs_kontext = function(var) {
|
||
if (grepl("^dsf_11", var)) return(list(min = "kein Schmerz", max = "staerkster vorstellbarer Schmerz"))
|
||
if (grepl("^dsf_12", var)) return(list(min = "keine Beeintraechtigung", max = "staerkste vorstellbare Beeintraechtigung"))
|
||
NULL
|
||
}
|
||
|
||
# Sucht das Ausfuelldatum ueber eine Kandidatenliste moeglicher Zeitstempel-
|
||
# Spalten (siehe DSF_DATUM_KANDIDATEN) - der exakte Name ist unverifiziert.
|
||
dsf_finde_ausfuelldatum = function(zeile) {
|
||
for (sp in DSF_DATUM_KANDIDATEN) {
|
||
if (sp %in% names(zeile)) {
|
||
wert = zeile[[sp]][1]
|
||
if (!is.null(wert) && !is.na(wert) && nchar(trimws(as.character(wert))) > 0) {
|
||
datum = tryCatch(as.Date(as.POSIXct(wert)), error = function(e) NA)
|
||
if (!is.na(datum)) return(datum)
|
||
}
|
||
}
|
||
}
|
||
NA
|
||
}
|
||
|
||
# Ordnet jede Spalte aus daten_dsf GENAU EINEM Modul zu (erster Treffer in der
|
||
# Reihenfolge von DSF_MODULE_TABELLE gewinnt), in der urspruenglichen Spalten-
|
||
# reihenfolge der xlsx. Nicht zugeordnete Spalten landen in "Sonstige Felder",
|
||
# damit nichts aus der xlsx stillschweigend wegfaellt (Abschnitt 2 Build-Prompt).
|
||
dsf_module_spalten_zuordnen = function(daten) {
|
||
alle_spalten = setdiff(names(daten), DSF_META_SPALTEN)
|
||
uebrig = alle_spalten
|
||
ergebnis = vector("list", length(DSF_MODULE_TABELLE))
|
||
|
||
for (i in seq_along(DSF_MODULE_TABELLE)) {
|
||
mod = DSF_MODULE_TABELLE[[i]]
|
||
treffer = character(0)
|
||
for (praefix in mod$praefixe) {
|
||
treffer = union(treffer, uebrig[grepl(praefix, uebrig)])
|
||
}
|
||
treffer = alle_spalten[alle_spalten %in% treffer]
|
||
ergebnis[[i]] = treffer
|
||
uebrig = setdiff(uebrig, treffer)
|
||
}
|
||
|
||
list(module = ergebnis, sonstige = uebrig)
|
||
}
|
||
|
||
# Gruppiert Spaltennamen eines Wiederholungsblocks nach Slot-Nummer: die erste
|
||
# Ziffernfolge NACH dem Blockpraefix bestimmt den Slot (z.B. "dsf_22_med4"
|
||
# -> Rest "_med4" -> Slot 4; "dsf_25_04_ja" -> Rest "_04_ja" -> Slot 4).
|
||
dsf_slot_gruppieren = function(vars, block_praefix) {
|
||
if (length(vars) == 0) return(list())
|
||
rest = sub(paste0("^", block_praefix), "", vars)
|
||
slot_nr = vapply(rest, function(r) {
|
||
m = regmatches(r, regexpr("[0-9]+", r))
|
||
if (length(m) == 0) return(NA_integer_)
|
||
as.integer(m[1])
|
||
}, integer(1))
|
||
gruppen = split(vars, slot_nr)
|
||
gruppen[order(as.integer(names(gruppen)))]
|
||
}
|
||
|
||
# Baut die generische Item-Liste eines Moduls (label/text-Paare, leere Felder
|
||
# bereits herausgefiltert durch dsf_render_item), anschliessend nach Wert
|
||
# sortiert, wo das sinnvoll ist (siehe dsf_sortiere_nach_wert).
|
||
dsf_baue_generisches_modul = function(daten, zeile, vars) {
|
||
ergebnisse = Filter(Negate(is.null), lapply(vars, function(v) dsf_render_item(daten, zeile, v)))
|
||
dsf_sortiere_nach_wert(ergebnisse)
|
||
}
|
||
|
||
# Sortiert Items MIT BEKANNTEM, GEMEINSAMEM Wertebereich (gleiches Minimum
|
||
# und Maximum, z.B. mehrere 0-10-NRS-Items im selben Modul) innerhalb ihrer
|
||
# Gruppe absteigend nach Wert. Items mit unterschiedlichem oder unbekanntem
|
||
# Wertebereich (qualitative Antworten, offene Zahlenfelder) behalten ihre
|
||
# urspruengliche Position - nur dort sortieren, wo ein Werte-Vergleich
|
||
# tatsaechlich sinnvoll ist ("wo sinnig").
|
||
dsf_sortiere_nach_wert = function(items) {
|
||
if (length(items) < 2) return(items)
|
||
|
||
schluessel = sapply(items, function(it) {
|
||
if (is.na(it$wert_num) || is.na(it$bereich_min) || is.na(it$bereich_max)) return(NA_character_)
|
||
paste0(it$bereich_min, "_", it$bereich_max)
|
||
})
|
||
|
||
ergebnis = items
|
||
for (k in unique(stats::na.omit(schluessel))) {
|
||
idx = which(schluessel == k)
|
||
if (length(idx) < 2) next
|
||
werte = sapply(items[idx], `[[`, "wert_num")
|
||
ergebnis[idx] = items[idx][order(werte, decreasing = TRUE)]
|
||
}
|
||
ergebnis
|
||
}
|
||
|
||
# Wiederholungsblock (Operationen/Medikamente): Slot gilt als ausgefuellt, wenn
|
||
# das erste Feld des Slots (Leitfeld, in xlsx-Reihenfolge) nicht leer ist.
|
||
# intro_vars: Felder OHNE Slot-Ziffer, die vor den nummerierten Slots als
|
||
# eigener titelloser Block gezeigt werden (z.B. dsf_21_ja/dsf_21_anzahl bei
|
||
# Operationen - beantworten "ueberhaupt Operationen?", nicht slotgebunden).
|
||
dsf_baue_slot_modul = function(daten, zeile, vars, block_praefix, slot_titel_praefix,
|
||
intro_vars = character(0)) {
|
||
slots = list()
|
||
|
||
intro_vars_vorhanden = intersect(intro_vars, vars)
|
||
if (length(intro_vars_vorhanden) > 0) {
|
||
intro_items = dsf_baue_generisches_modul(daten, zeile, intro_vars_vorhanden)
|
||
if (length(intro_items) > 0) {
|
||
slots[[length(slots) + 1]] = list(titel = NA_character_, items = intro_items)
|
||
}
|
||
}
|
||
|
||
rest_vars = setdiff(vars, intro_vars)
|
||
gruppen = dsf_slot_gruppieren(rest_vars, block_praefix)
|
||
for (slot_nr in names(gruppen)) {
|
||
slot_vars = gruppen[[slot_nr]]
|
||
leitfeld = slot_vars[1]
|
||
if (!dsf_ist_ausgefuellt(zeile[[leitfeld]])) next
|
||
items = dsf_baue_generisches_modul(daten, zeile, slot_vars)
|
||
if (length(items) == 0) next
|
||
slots[[length(slots) + 1]] = list(
|
||
titel = paste0(slot_titel_praefix, " ", slot_nr),
|
||
items = items
|
||
)
|
||
}
|
||
slots
|
||
}
|
||
|
||
# Komorbiditaeten: Slot gilt als ausgefuellt, wenn das Leitfeld mit "ja"
|
||
# beantwortet wurde (nicht schon bei blosser Nicht-Leere, da "nein" eine
|
||
# gueltige, aber hier nicht anzuzeigende Antwort ist).
|
||
dsf_baue_komorbiditaeten_modul = function(daten, zeile, vars, block_praefix) {
|
||
gruppen = dsf_slot_gruppieren(vars, block_praefix)
|
||
slots = list()
|
||
for (slot_nr in names(gruppen)) {
|
||
slot_vars = gruppen[[slot_nr]]
|
||
leitfeld = slot_vars[1]
|
||
if (!(leitfeld %in% names(daten))) next
|
||
anker = normalisiere_text(dsf_anker_text(daten[[leitfeld]], zeile[[leitfeld]]))
|
||
if (is.na(anker) || !identical(anker, "ja")) next
|
||
kategorie_titel = dsf_clean_label(attr(daten[[leitfeld]], "label"))
|
||
if (is.na(kategorie_titel)) kategorie_titel = paste0("Kategorie ", slot_nr)
|
||
uebrige_vars = setdiff(slot_vars, leitfeld)
|
||
items = dsf_baue_generisches_modul(daten, zeile, uebrige_vars)
|
||
slots[[length(slots) + 1]] = list(titel = kategorie_titel, items = items)
|
||
}
|
||
slots
|
||
}
|
||
|
||
# Bisherige Behandlungen (dsf_20): 14 feste Behandlungskategorien
|
||
# (dsf_20_01_erhalten .. dsf_20_14_erhalten, jeweils mit "_wirksam"-Unter-
|
||
# frage), plus dsf_20_keine ("bisher keine Schmerzbehandlung") und
|
||
# dsf_20_andere_frei/_wirksam (Freitext-Kategorie). Anders als die generischen
|
||
# Wiederholungsbloecke ist die Anzahl der Kategorien fix und aus der xlsx
|
||
# bekannt (nicht ueber Regex-Slotnummern hergeleitet), da das Leitfeld hier
|
||
# ein check-Item ("erhalten") und keine freie Nummerierung ist.
|
||
dsf_baue_behandlungen_modul = function(daten, zeile, vars) {
|
||
slots = list()
|
||
|
||
if ("dsf_20_keine" %in% vars && dsf_ist_ausgefuellt(zeile[["dsf_20_keine"]])) {
|
||
titel = dsf_clean_label(attr(daten[["dsf_20_keine"]], "label"))
|
||
if (is.na(titel)) titel = "Bisher keine Schmerzbehandlung"
|
||
slots[[length(slots) + 1]] = list(titel = titel, items = list())
|
||
}
|
||
|
||
# Nur Behandlungen zeigen, die sowohl erhalten als auch wirksam ("ja" bei
|
||
# der wirksam?-Unterfrage) waren - "vorübergehend"/"nein"/fehlende Angabe
|
||
# werden herausgefiltert (analog zum "nur ja" bei Komorbiditaeten).
|
||
wirksam_ist_ja = function(wirksam_var) {
|
||
if (!(wirksam_var %in% vars)) return(FALSE)
|
||
anker = normalisiere_text(dsf_anker_text(daten[[wirksam_var]], zeile[[wirksam_var]]))
|
||
!is.na(anker) && identical(anker, "ja")
|
||
}
|
||
|
||
for (nr in sprintf("%02d", 1:14)) {
|
||
erhalten_var = paste0("dsf_20_", nr, "_erhalten")
|
||
wirksam_var = paste0("dsf_20_", nr, "_wirksam")
|
||
if (!(erhalten_var %in% vars) || !dsf_ist_ausgefuellt(zeile[[erhalten_var]])) next
|
||
if (!wirksam_ist_ja(wirksam_var)) next
|
||
titel = dsf_clean_label(attr(daten[[erhalten_var]], "label"))
|
||
if (is.na(titel)) titel = paste0("Behandlung ", nr)
|
||
# wirksam-Feld wird nicht mehr mitangezeigt - durch den Filter oben ist
|
||
# es fuer jeden verbliebenen Eintrag ohnehin "ja" (wie bei Komorbiditaeten).
|
||
slots[[length(slots) + 1]] = list(titel = titel, items = list())
|
||
}
|
||
|
||
if ("dsf_20_andere_frei" %in% vars && dsf_ist_ausgefuellt(zeile[["dsf_20_andere_frei"]]) &&
|
||
wirksam_ist_ja("dsf_20_andere_wirksam")) {
|
||
andere_text = dsf_render_item(daten, zeile, "dsf_20_andere_frei")
|
||
titel = if (!is.null(andere_text)) paste0("Anderes: ", andere_text$text) else "Anderes"
|
||
slots[[length(slots) + 1]] = list(titel = titel, items = list())
|
||
}
|
||
|
||
slots
|
||
}
|
||
|
||
# Koerperschema: paingrid_n generisch, paingrid_data wird ueber das im
|
||
# paingrid_widget-Notizfeld dokumentierte Rasterschema (60x48, Zell-ID
|
||
# "r<ZZ>_c<SS>") geparst und als Markierungs-Overlay auf dem Hintergrundbild
|
||
# angezeigt (Bildschirm: CSS-Grid: Word-Export: rasterisiertes ggplot-Bild).
|
||
dsf_baue_paingrid_modul = function(daten, zeile) {
|
||
n_wert = if ("paingrid_n" %in% names(zeile)) zeile[["paingrid_n"]][1] else NA
|
||
n_text = if (!is.null(n_wert) && !is.na(n_wert)) as.character(n_wert) else NULL
|
||
|
||
data_wert = if ("paingrid_data" %in% names(zeile)) zeile[["paingrid_data"]][1] else NA
|
||
data_text = if (!is.null(data_wert) && !is.na(data_wert) && nchar(trimws(as.character(data_wert))) > 0)
|
||
as.character(data_wert) else NULL
|
||
|
||
geparst = dsf_parse_paingrid_data(data_text)
|
||
|
||
list(n_text = n_text, data_text = data_text,
|
||
grid_rows = geparst$grid_rows, grid_cols = geparst$grid_cols, zellen = geparst$zellen)
|
||
}
|
||
|
||
# Baut das CSS-Grid-Overlay fuer die Bildschirmanzeige: Hintergrundbild +
|
||
# absolut positionierte Markierungs-Divs an genau den Rasterpositionen, die
|
||
# das Eingabewidget selbst verwendet (identische grid-template-Definition).
|
||
# Bild wird als base64-Data-URI eingebettet statt als www/-Asset referenziert -
|
||
# siehe Kommentar bei DSF_KOERPERSCHEMA_DATA_URI.
|
||
dsf_paingrid_overlay_ui = function(zellen, grid_rows, grid_cols) {
|
||
if (is.na(DSF_KOERPERSCHEMA_DATA_URI)) {
|
||
return(div(class = "alert-warnung",
|
||
"Koerperschema-Hintergrundbild nicht gefunden (", basename(PFAD_KOERPERSCHEMA_BILD), ")."))
|
||
}
|
||
|
||
marker_farbe = dsf_hex_zu_rgba(AKZENT_FARBE, 0.55)
|
||
marker_divs = if (nrow(zellen) > 0) lapply(seq_len(nrow(zellen)), function(i) {
|
||
div(style = paste0(
|
||
"grid-row:", zellen$row[i], "; grid-column:", zellen$col[i], "; ",
|
||
"background:", marker_farbe, "; outline:1px solid ", AKZENT_FARBE, ";"
|
||
))
|
||
}) else NULL
|
||
|
||
div(class = "koerperschema-box",
|
||
tags$img(src = DSF_KOERPERSCHEMA_DATA_URI, alt = "Koerperschema Vorder- und Rueckansicht",
|
||
style = "display:block; width:100%; height:auto; user-select:none;"),
|
||
div(style = paste0(
|
||
"position:absolute; inset:0; display:grid; ",
|
||
"grid-template-columns:repeat(", grid_cols, ",1fr); ",
|
||
"grid-template-rows:repeat(", grid_rows, ",1fr);"
|
||
),
|
||
marker_divs
|
||
)
|
||
)
|
||
}
|
||
|
||
# Rasterisiert Hintergrundbild + Markierungen fuer den Word-Export in eine
|
||
# temporaere PNG-Datei (officer kann keine HTML/CSS-Overlays einbetten).
|
||
# Zellkoordinaten werden als Bruchteil von grid_rows/grid_cols auf die
|
||
# tatsaechlichen Pixelmasse des Bildes umgerechnet (Zeile 1 = oben, daher
|
||
# y-Achse gegenueber ggplot-Koordinaten gespiegelt).
|
||
dsf_erstelle_paingrid_bild_datei = function(zellen, grid_rows, grid_cols) {
|
||
if (!file.exists(PFAD_KOERPERSCHEMA_BILD)) return(NULL)
|
||
img = png::readPNG(PFAD_KOERPERSCHEMA_BILD)
|
||
img_h = dim(img)[1]
|
||
img_w = dim(img)[2]
|
||
|
||
p = ggplot() +
|
||
annotation_raster(img, xmin = 0, xmax = img_w, ymin = 0, ymax = img_h) +
|
||
coord_fixed(xlim = c(0, img_w), ylim = c(0, img_h), expand = FALSE) +
|
||
theme_void()
|
||
|
||
if (nrow(zellen) > 0) {
|
||
zellen_px = data.frame(
|
||
x = (zellen$col - 0.5) / grid_cols * img_w,
|
||
y = img_h - (zellen$row - 0.5) / grid_rows * img_h
|
||
)
|
||
zell_b = img_w / grid_cols
|
||
zell_h = img_h / grid_rows
|
||
p = p + geom_tile(data = zellen_px, aes(x = x, y = y), width = zell_b, height = zell_h,
|
||
fill = AKZENT_FARBE, alpha = 0.55, color = AKZENT_FARBE, linewidth = 0.15)
|
||
}
|
||
|
||
tmp = tempfile(fileext = ".png")
|
||
tryCatch({
|
||
ggsave(tmp, plot = p, width = img_w / 150, height = img_h / 150, dpi = 150, bg = "white")
|
||
list(pfad = tmp, breite_zu_hoehe = img_h / img_w)
|
||
}, error = function(e) NULL)
|
||
}
|
||
|
||
# HADS-D (Frage 17) + Suizid-Screening (Frage 18). Einzige berechnete Kennzahl
|
||
# dieser App - siehe Abschnitt 3 des Build-Prompts.
|
||
dsf_baue_hads_modul = function(daten, zeile) {
|
||
items = lapply(names(DSF_HADS_ITEMS), function(var) {
|
||
info = DSF_HADS_ITEMS[[var]]
|
||
if (var %in% names(daten)) {
|
||
r = dsf_hads_item_score(daten[[var]], zeile[[var]], info$anker)
|
||
item_text = dsf_clean_label(attr(daten[[var]], "label"))
|
||
} else {
|
||
r = list(score = NA_integer_, anker_text = NA_character_)
|
||
item_text = NA_character_
|
||
}
|
||
list(
|
||
var = var,
|
||
subskala = info$subskala,
|
||
score = r$score,
|
||
anker_text = r$anker_text,
|
||
item_text = if (is.na(item_text)) var else item_text
|
||
)
|
||
})
|
||
names(items) = names(DSF_HADS_ITEMS)
|
||
|
||
angst_vars = names(DSF_HADS_ITEMS)[sapply(DSF_HADS_ITEMS, `[[`, "subskala") == "Angst"]
|
||
depr_vars = names(DSF_HADS_ITEMS)[sapply(DSF_HADS_ITEMS, `[[`, "subskala") == "Depression"]
|
||
|
||
summiere = function(vars) {
|
||
scores = sapply(items[vars], `[[`, "score")
|
||
if (any(is.na(scores))) return(NA_integer_)
|
||
as.integer(sum(scores))
|
||
}
|
||
|
||
klassifiziere = function(summe, cutoff, name) {
|
||
if (is.na(summe)) return("nicht berechenbar")
|
||
if (summe > cutoff) paste0("psychisch auffaellig (", name, ")") else "im Normbereich"
|
||
}
|
||
|
||
angst_summe = summiere(angst_vars)
|
||
depr_summe = summiere(depr_vars)
|
||
|
||
suizid_text = NA_character_
|
||
suizid_item_text = "Ich denke des oefteren daran, mir das Leben zu nehmen."
|
||
suizid_ja = FALSE
|
||
if ("dsf_18" %in% names(daten)) {
|
||
suizid_text = dsf_anker_text(daten[["dsf_18"]], zeile[["dsf_18"]])
|
||
lbl = dsf_clean_label(attr(daten[["dsf_18"]], "label"))
|
||
if (!is.na(lbl)) suizid_item_text = lbl
|
||
suizid_ja = identical(normalisiere_text(suizid_text), "ja")
|
||
}
|
||
|
||
list(
|
||
items = items,
|
||
reihenfolge = names(DSF_HADS_ITEMS),
|
||
angst_summe = angst_summe,
|
||
depr_summe = depr_summe,
|
||
angst_klasse = klassifiziere(angst_summe, 10, "Angst"),
|
||
depr_klasse = klassifiziere(depr_summe, 8, "Depression"),
|
||
suizid_ja = suizid_ja,
|
||
suizid_text = suizid_text,
|
||
suizid_item_text = suizid_item_text
|
||
)
|
||
}
|
||
|
||
# Baut die vollstaendige Modulliste einmal auf - wird sowohl fuer die Bild-
|
||
# schirmanzeige als auch fuer den Word-Export verwendet (kein Doppelcode).
|
||
dsf_baue_module_liste = function(daten, zeile) {
|
||
zuordnung = dsf_module_spalten_zuordnen(daten)
|
||
ergebnis = list()
|
||
|
||
for (i in seq_along(DSF_MODULE_TABELLE)) {
|
||
mod = DSF_MODULE_TABELLE[[i]]
|
||
vars = zuordnung$module[[i]]
|
||
|
||
if (identical(mod$spezial, "paingrid")) {
|
||
pg = dsf_baue_paingrid_modul(daten, zeile)
|
||
if (is.null(pg$n_text) && is.null(pg$data_text)) next
|
||
ergebnis[[length(ergebnis) + 1]] = list(id = "paingrid", titel = mod$titel, hinweis = mod$hinweis, daten = pg)
|
||
next
|
||
}
|
||
|
||
if (identical(mod$spezial, "hads")) {
|
||
hads = dsf_baue_hads_modul(daten, zeile)
|
||
ergebnis[[length(ergebnis) + 1]] = list(id = "hads", titel = mod$titel, hinweis = mod$hinweis, daten = hads)
|
||
next
|
||
}
|
||
|
||
if (identical(mod$spezial, "behandlungen")) {
|
||
slots = dsf_baue_behandlungen_modul(daten, zeile, vars)
|
||
if (length(slots) == 0) next
|
||
ergebnis[[length(ergebnis) + 1]] = list(id = "slots", titel = mod$titel, hinweis = mod$hinweis, daten = slots)
|
||
next
|
||
}
|
||
|
||
if (identical(mod$spezial, "operationen")) {
|
||
slots = dsf_baue_slot_modul(daten, zeile, vars, "dsf_21", "Operation",
|
||
intro_vars = c("dsf_21_ja", "dsf_21_anzahl"))
|
||
if (length(slots) == 0) next
|
||
ergebnis[[length(ergebnis) + 1]] = list(id = "slots", titel = mod$titel, hinweis = mod$hinweis, daten = slots)
|
||
next
|
||
}
|
||
if (identical(mod$spezial, "medikamente_aktuell")) {
|
||
slots = dsf_baue_slot_modul(daten, zeile, vars, "dsf_22", "Medikament")
|
||
if (length(slots) == 0) next
|
||
ergebnis[[length(ergebnis) + 1]] = list(id = "slots", titel = mod$titel, hinweis = mod$hinweis, daten = slots)
|
||
next
|
||
}
|
||
if (identical(mod$spezial, "medikamente_frueher")) {
|
||
slots = dsf_baue_slot_modul(daten, zeile, vars, "dsf_23", "Medikament (frueher)")
|
||
if (length(slots) == 0) next
|
||
ergebnis[[length(ergebnis) + 1]] = list(id = "slots", titel = mod$titel, hinweis = mod$hinweis, daten = slots)
|
||
next
|
||
}
|
||
if (identical(mod$spezial, "komorbiditaeten")) {
|
||
slots = dsf_baue_komorbiditaeten_modul(daten, zeile, vars, "dsf_25")
|
||
if (length(slots) == 0) next
|
||
ergebnis[[length(ergebnis) + 1]] = list(id = "slots", titel = mod$titel, hinweis = mod$hinweis, daten = slots)
|
||
next
|
||
}
|
||
|
||
items = dsf_baue_generisches_modul(daten, zeile, vars)
|
||
if (length(items) == 0) next
|
||
ergebnis[[length(ergebnis) + 1]] = list(id = "generisch", titel = mod$titel, hinweis = mod$hinweis, daten = items)
|
||
}
|
||
|
||
if (length(zuordnung$sonstige) > 0) {
|
||
items = dsf_baue_generisches_modul(daten, zeile, zuordnung$sonstige)
|
||
if (length(items) > 0) {
|
||
ergebnis[[length(ergebnis) + 1]] = list(
|
||
id = "generisch", titel = "Sonstige Felder",
|
||
hinweis = "nicht in der Modul-Zuordnungstabelle erfasst - Sicherheitsnetz, damit nichts aus der xlsx fehlt",
|
||
daten = items
|
||
)
|
||
}
|
||
}
|
||
|
||
ergebnis
|
||
}
|
||
|
||
erstelle_hads_balken = function(score, cutoff, titel) {
|
||
score_farbe = if (is.na(score)) "#888888" else if (score > cutoff) "#B71C1C" else "#2E7D32"
|
||
|
||
p = ggplot() +
|
||
geom_rect(aes(xmin = 0, xmax = cutoff, ymin = 0, ymax = 1), fill = "#E8F5E9", color = NA) +
|
||
geom_rect(aes(xmin = cutoff, xmax = 21, ymin = 0, ymax = 1), fill = "#FFEBEE", color = NA) +
|
||
geom_rect(aes(xmin = 0, xmax = 21, ymin = 0, ymax = 1), fill = NA, color = "#9E9E9E", linewidth = 0.6) +
|
||
geom_vline(xintercept = cutoff, color = "#E65100", linetype = "dashed", linewidth = 1) +
|
||
annotate("text", x = cutoff, y = -0.55, label = paste0("Cutoff: > ", cutoff),
|
||
color = "#E65100", size = 3.2) +
|
||
scale_x_continuous(limits = c(-1, 22), breaks = c(0, cutoff, 21)) +
|
||
scale_y_continuous(limits = c(-0.8, 2.0)) +
|
||
theme_minimal(base_size = 12) +
|
||
theme(
|
||
axis.text.y = element_blank(),
|
||
axis.ticks.y = element_blank(),
|
||
panel.grid.major.y = element_blank(),
|
||
panel.grid.minor = element_blank(),
|
||
axis.title.y = element_blank(),
|
||
plot.margin = margin(t = 5, r = 10, b = 5, l = 10)
|
||
) +
|
||
labs(x = paste0(titel, " - Summe (0-21)"), y = NULL)
|
||
|
||
if (!is.na(score)) {
|
||
p = p +
|
||
geom_segment(aes(x = score, xend = score, y = -0.25, yend = 1.25),
|
||
color = score_farbe, linewidth = 2.5) +
|
||
geom_label(aes(x = score, y = 1.6, label = paste0("Score: ", score)),
|
||
fill = score_farbe, color = "white", fontface = "bold",
|
||
linewidth = 0, size = 4)
|
||
}
|
||
p
|
||
}
|
||
|
||
|
||
# Datenaufbereitung ####
|
||
|
||
# formr-Metaspalten, die aus der generischen Modulzuordnung ausgeschlossen
|
||
# werden. Namen unverifiziert (siehe Punkt 5 der unverifizierten Annahmen).
|
||
DSF_META_SPALTEN = c("session", "created", "modified", "ended", "expired", "expired_at", "code")
|
||
|
||
# Dokumentierte Wertebereiche (Minimum, Maximum) der range_ticks-Items, direkt
|
||
# aus dem type-String der dsf.xlsx uebernommen (z.B. "range_ticks 0,10,1").
|
||
# Nur fuer Items in dieser Tabelle wird ein Farbverlauf-Badge berechnet; reine
|
||
# "number"-Felder ohne bekannte Obergrenze (Alter, Anzahl etc.) erhalten einen
|
||
# neutralen Badge ohne Verlauf (siehe dsf_wert_badge_farbe).
|
||
DSF_WERTEBEREICHE = list(
|
||
dsf_11a = c(0, 10), dsf_11b = c(0, 10), dsf_11c = c(0, 10), dsf_11d = c(0, 10),
|
||
dsf_12b = c(0, 10), dsf_12c = c(0, 10), dsf_12d = c(0, 10),
|
||
dsf_16_01 = c(0, 5), dsf_16_02 = c(0, 5), dsf_16_03 = c(0, 5), dsf_16_04 = c(0, 5),
|
||
dsf_16_05 = c(0, 5), dsf_16_06 = c(0, 5), dsf_16_07 = c(0, 5),
|
||
dsf_a1 = c(-100, 100)
|
||
)
|
||
|
||
# Ankertext -> Ordinalposition (choice1=1, choice2=2, ...), transkribiert aus
|
||
# der xlsx fuer mc-Items OHNE selbstdeklarierte Zahl im Ankertext (SF-12,
|
||
# Modul A). Druecken nur die Position auf der Antwortskala aus, keine
|
||
# Wertung - siehe Kommentar bei dsf_ordinal_wert.
|
||
DSF_ORDINAL_ANKER_ITEMS = list(
|
||
dsf_l01 = c("ausgezeichnet" = 1, "sehr gut" = 2, "gut" = 3, "weniger gut" = 4, "schlecht" = 5),
|
||
dsf_l02 = c("ja, stark eingeschraenkt" = 1, "ja, etwas eingeschraenkt" = 2,
|
||
"nein, ueberhaupt nicht eingeschraenkt" = 3),
|
||
dsf_l03 = c("ja, stark eingeschraenkt" = 1, "ja, etwas eingeschraenkt" = 2,
|
||
"nein, ueberhaupt nicht eingeschraenkt" = 3),
|
||
dsf_l04 = c("ja" = 1, "nein" = 2),
|
||
dsf_l05 = c("ja" = 1, "nein" = 2),
|
||
dsf_l06 = c("ja" = 1, "nein" = 2),
|
||
dsf_l07 = c("ja" = 1, "nein" = 2),
|
||
dsf_l08 = c("ueberhaupt nicht" = 1, "ein bisschen" = 2, "maessig" = 3, "ziemlich" = 4, "sehr" = 5),
|
||
dsf_l09 = c("immer" = 1, "meistens" = 2, "ziemlich" = 3, "manchmal" = 4, "selten" = 5, "nie" = 6),
|
||
dsf_l10 = c("immer" = 1, "meistens" = 2, "ziemlich" = 3, "manchmal" = 4, "selten" = 5, "nie" = 6),
|
||
dsf_l11 = c("immer" = 1, "meistens" = 2, "ziemlich" = 3, "manchmal" = 4, "selten" = 5, "nie" = 6),
|
||
dsf_l12 = c("immer" = 1, "meistens" = 2, "manchmal" = 3, "selten" = 4, "nie" = 5),
|
||
dsf_a2 = c("ausreichend" = 1, "nicht ausreichend" = 2),
|
||
dsf_a3 = c("nein" = 1, "ja" = 2),
|
||
dsf_a4 = c("nein" = 1, "ja, ein wenig" = 2, "deutlich" = 3, "stark" = 4, "fast voellig" = 5),
|
||
dsf_a5 = c("nein" = 1, "ja, ein wenig" = 2, "deutlich" = 3, "stark" = 4, "sehr stark" = 5),
|
||
dsf_a6 = c("nein" = 1, "ja, ein wenig" = 2, "deutlich" = 3, "stark" = 4, "sehr stark" = 5)
|
||
)
|
||
|
||
# Ankertext -> HADS-Score (0-3), transkribiert aus dem Wortlaut der dsf.xlsx
|
||
# (siehe Abschnitt 3.1 des Build-Prompts). Quelle der Wahrheit fuer den Recode
|
||
# ist ausschliesslich diese Tabelle in Verbindung mit dem Ankertext aus den
|
||
# Daten - niemals die Position in choice1-choice4 oder der Rohwert.
|
||
DSF_HADS_ITEMS = list(
|
||
dsf_17_01 = list(subskala = "Angst", anker = c(
|
||
"meistens" = 3, "oft" = 2, "von zeit zu zeit, gelegentlich" = 1, "ueberhaupt nicht" = 0)),
|
||
dsf_17_02 = list(subskala = "Depression", anker = c(
|
||
"fast immer" = 3, "sehr oft" = 2, "manchmal" = 1, "ueberhaupt nicht" = 0)),
|
||
dsf_17_03 = list(subskala = "Depression", anker = c(
|
||
"ganz genau so" = 0, "nicht ganz so sehr" = 1, "nur noch ein wenig" = 2, "kaum oder gar nicht" = 3)),
|
||
dsf_17_04 = list(subskala = "Angst", anker = c(
|
||
"ueberhaupt nicht" = 0, "gelegentlich" = 1, "ziemlich oft" = 2, "sehr oft" = 3)),
|
||
dsf_17_05 = list(subskala = "Angst", anker = c(
|
||
"ja, sehr stark" = 3, "ja, aber nicht allzu stark" = 2,
|
||
"etwas, aber es macht mir keine sorgen" = 1, "ueberhaupt nicht" = 0)),
|
||
dsf_17_06 = list(subskala = "Depression", anker = c(
|
||
"ja, stimmt genau" = 3, "ich kuemmere mich nicht so sehr darum, wie ich sollte" = 2,
|
||
"moeglicherweise kuemmere ich mich zu wenig darum" = 1, "ich kuemmere mich so viel darum wie immer" = 0)),
|
||
dsf_17_07 = list(subskala = "Depression", anker = c(
|
||
"ja, so viel wie immer" = 0, "nicht mehr ganz so viel" = 1,
|
||
"inzwischen viel weniger" = 2, "ueberhaupt nicht" = 3)),
|
||
dsf_17_08 = list(subskala = "Angst", anker = c(
|
||
"ja, tatsaechlich sehr" = 3, "ziemlich" = 2, "nicht sehr" = 1, "ueberhaupt nicht" = 0)),
|
||
dsf_17_09 = list(subskala = "Angst", anker = c(
|
||
"einen grossteil der zeit" = 3, "verhaeltnismaessig oft" = 2,
|
||
"von zeit zu zeit, aber nicht allzu oft" = 1, "nur gelegentlich" = 0)),
|
||
dsf_17_10 = list(subskala = "Depression", anker = c(
|
||
"ja, sehr" = 0, "eher weniger als frueher" = 1, "viel weniger als frueher" = 2, "kaum bis gar nicht" = 3)),
|
||
dsf_17_11 = list(subskala = "Depression", anker = c(
|
||
"ueberhaupt nicht" = 3, "selten" = 2, "manchmal" = 1, "meistens" = 0)),
|
||
dsf_17_12 = list(subskala = "Angst", anker = c(
|
||
"ja, tatsaechlich sehr oft" = 3, "ziemlich oft" = 2, "nicht sehr oft" = 1, "ueberhaupt nicht" = 0)),
|
||
dsf_17_13 = list(subskala = "Angst", anker = c(
|
||
"ja, natuerlich" = 0, "gewoehnlich schon" = 1, "nicht oft" = 2, "ueberhaupt nicht" = 3)),
|
||
dsf_17_14 = list(subskala = "Depression", anker = c(
|
||
"oft" = 0, "manchmal" = 1, "eher selten" = 2, "sehr selten" = 3))
|
||
)
|
||
|
||
# Modul-Zuordnung: Item-Praefix(e, als Regex) -> Anzeige-Modul, in der
|
||
# Reihenfolge der xlsx (Abschnitt 4 des Build-Prompts). "spezial" markiert
|
||
# Module mit eigener Renderlogik statt der generischen Ein-Spalten-Anzeige.
|
||
DSF_MODULE_TABELLE = list(
|
||
list(titel = "Persoenliche Angaben",
|
||
praefixe = c("^dsf_geburtsdatum", "^dsf_alter", "^dsf_geschlecht", "^dsf_groesse", "^dsf_gewicht")),
|
||
list(titel = "Koerperschema (Schmerzlokalisation)",
|
||
praefixe = c("^paingrid_"), spezial = "paingrid"),
|
||
list(titel = "Schmerzbeschreibung (Freitext)",
|
||
praefixe = c("^dsf_schmerzbeschreibung_frei", "^dsf_06")),
|
||
list(titel = "Schmerzbeginn", praefixe = c("^dsf_07")),
|
||
list(titel = "Schmerzverlauf", praefixe = c("^dsf_08")),
|
||
list(titel = "Tageszeitliche Schwankungen", praefixe = c("^dsf_09_")),
|
||
list(titel = "Schmerzbeschreibungsliste (SBL)", praefixe = c("^dsf_10_"),
|
||
hinweis = "rein deskriptiv, kein Score"),
|
||
list(titel = "Schmerzstaerke (NRS 0-10)", praefixe = c("^dsf_11"),
|
||
hinweis = "rein deskriptiv"),
|
||
list(titel = "Schmerzbedingte Beeintraechtigung (NRS 0-10)", praefixe = c("^dsf_12"),
|
||
hinweis = "rein deskriptiv"),
|
||
list(titel = "Ursachen der Schmerzen", praefixe = c("^dsf_13")),
|
||
list(titel = "Eigene schmerzlindernde Massnahmen", praefixe = c("^dsf_14")),
|
||
list(titel = "Schmerzausloesende/-verschlimmernde Faktoren", praefixe = c("^dsf_15")),
|
||
list(titel = "Fragebogen Wohlbefinden (FW7)", praefixe = c("^dsf_16_"),
|
||
hinweis = "rein deskriptiv, kein Score"),
|
||
list(titel = "HADS-D (Angst/Depression) + Suizid-Screening",
|
||
praefixe = c("^dsf_17_", "^dsf_18$"), spezial = "hads",
|
||
hinweis = "einzig gescorter Abschnitt dieser App"),
|
||
list(titel = "Bisherige Diagnostik", praefixe = c("^dsf_19")),
|
||
list(titel = "Bisherige Behandlungen", praefixe = c("^dsf_20"), spezial = "behandlungen",
|
||
hinweis = "gefiltert auf als wirksam (\"ja\") angegebene Behandlungen"),
|
||
list(titel = "Operationen", praefixe = c("^dsf_21"), spezial = "operationen"),
|
||
list(titel = "Aktuelle Medikamenteneinnahme", praefixe = c("^dsf_22"), spezial = "medikamente_aktuell"),
|
||
list(titel = "Fruehere Schmerzmedikamente", praefixe = c("^dsf_23"), spezial = "medikamente_frueher"),
|
||
list(titel = "Medikamentenallergien", praefixe = c("^dsf_24")),
|
||
list(titel = "Komorbiditaeten", praefixe = c("^dsf_25"), spezial = "komorbiditaeten"),
|
||
list(titel = "SF-12 (Allgemeiner Gesundheitszustand)", praefixe = c("^dsf_l"),
|
||
hinweis = "rein deskriptiv, kein Score"),
|
||
list(titel = "Allgemeinbefindlichkeit (Modul A)", praefixe = c("^dsf_a"),
|
||
hinweis = "rein deskriptiv")
|
||
)
|
||
|
||
|
||
# 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: 6px;
|
||
}
|
||
.modul-hinweis { font-size: 0.8em; color: #888; font-style: italic; margin-bottom: 12px; }
|
||
.meta-block { margin-bottom: 10px; color: #555; font-size: 0.95em; }
|
||
.meta-block strong { color: #222; }
|
||
.item-zeile {
|
||
display: flex; align-items: flex-start; 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: 26px; flex-shrink: 0; }
|
||
.item-text { flex: 1; color: #333; font-size: 0.92em; }
|
||
.item-wert { color: #555; font-size: 0.92em; }
|
||
.stufe-badge-0, .stufe-badge-1, .stufe-badge-2, .stufe-badge-3 {
|
||
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; }
|
||
.disclaimer-text {
|
||
font-size: 0.82em; color: #777; font-style: italic;
|
||
margin-top: 10px; border-top: 1px solid rgba(0,0,0,.1); padding-top: 8px;
|
||
}
|
||
.suizid-block {
|
||
background-color: #6D0000; color: white; border-radius: 6px;
|
||
padding: 16px 20px; margin-bottom: 16px; border-left: 6px solid #FF6B6B;
|
||
}
|
||
.suizid-block h4 { margin: 0 0 9px; font-size: 1.1em; font-weight: 700; }
|
||
.suizid-block .antwort-text {
|
||
background: rgba(255,255,255,0.12); border-radius: 3px;
|
||
padding: 7px 10px; margin: 6px 0; font-size: 0.92em; line-height: 1.5;
|
||
}
|
||
.suizid-block .disclaimer { margin-top: 10px; font-size: 0.82em; opacity: 0.85; font-style: italic; }
|
||
.slot-karte {
|
||
border: 1px solid #eee; border-radius: 5px; padding: 10px 14px;
|
||
margin-bottom: 10px; background: #fafafa;
|
||
}
|
||
.slot-titel { font-weight: 700; color: #333; margin-bottom: 6px; font-size: 0.95em; }
|
||
.koerperschema-box {
|
||
position: relative; max-width: 380px; margin: 8px auto 4px;
|
||
border: 1px solid #bbb; background: #fff; border-radius: 4px;
|
||
}
|
||
.start-hinweis { text-align: center; color: #bbb; padding: 40px 0; font-size: 0.95em; }
|
||
details.rohdaten-details summary {
|
||
cursor: pointer; font-weight: 600; color: #555; font-size: 0.88em; margin-top: 6px;
|
||
}
|
||
details.rohdaten-details pre {
|
||
white-space: pre-wrap; word-break: break-all; font-size: 0.78em;
|
||
color: #666; background: #f7f7f7; padding: 8px; border-radius: 4px; margin-top: 6px;
|
||
}
|
||
"
|
||
|
||
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("Deutscher Schmerzfragebogen (DSF)"),
|
||
tags$p("Vollstaendige Auswertung | Einzige berechnete Kennzahl: HADS-D (Angst/Depression)")
|
||
),
|
||
|
||
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("ergebnis_ui")
|
||
)
|
||
)
|
||
|
||
|
||
# Word-Export ####
|
||
|
||
erstelle_dsf_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_hinweis = fp_text(font.size = 9, italic = TRUE, color = "#888888")
|
||
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
||
fp_suizid = fp_text(font.size = 11, bold = TRUE, color = "#B71C1C")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("Deutscher Schmerzfragebogen - Auswertung", fp_titel)))
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext("Chiffre: ", 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")
|
||
|
||
hads = Filter(function(m) m$id == "hads", erg$module)
|
||
if (length(hads) > 0) {
|
||
hads = hads[[1]]$daten
|
||
|
||
if (isTRUE(hads$suizid_ja)) {
|
||
doc = body_add_fpar(doc, fpar(ftext("Suizid-Screening (Frage 18)", fp_abschnitt)))
|
||
doc = body_add_fpar(doc, fpar(ftext(hads$suizid_item_text, fp_suizid)))
|
||
doc = body_add_fpar(doc, fpar(ftext(paste0("Antwort: ", hads$suizid_text), fp_suizid)))
|
||
doc = body_add_fpar(doc, fpar(ftext(
|
||
"Kein automatisiertes klinisches Urteil, bitte umgehend fachlich abklaeren.",
|
||
fp_hinweis)))
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
}
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("HADS-D - Subskalen", fp_abschnitt)))
|
||
for (sub in list(list(n = "Angst", summe = hads$angst_summe, klasse = hads$angst_klasse),
|
||
list(n = "Depression", summe = hads$depr_summe, klasse = hads$depr_klasse))) {
|
||
farbe = if (grepl("auffaellig", sub$klasse)) "#C62828" else if (grepl("Normbereich", sub$klasse)) "#2E7D32" else "#888888"
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(paste0(sub$n, "-Summe: "), fp_label),
|
||
ftext(if (is.na(sub$summe)) "n/a" else paste0(sub$summe, " / 21"),
|
||
fp_text(bold = TRUE, font.size = 12, color = farbe)),
|
||
ftext(paste0(" ", sub$klasse), fp_text(font.size = 10, color = farbe))
|
||
))
|
||
}
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("HADS-D - Einzelitems", fp_abschnitt)))
|
||
for (var in hads$reihenfolge) {
|
||
it = hads$items[[var]]
|
||
stufe_key = if (!is.na(it$score)) as.character(it$score) else "0"
|
||
stufe_txt = if (is.na(it$score)) "k.A." else as.character(it$score)
|
||
fp_badge = fp_text(bold = TRUE, font.size = 10,
|
||
color = DSF_BADGE_TEXT_FARBEN[[stufe_key]],
|
||
shading.color = DSF_BADGE_FARBEN[[stufe_key]])
|
||
anker_txt = if (is.na(it$anker_text)) "(keine Angabe)" else it$anker_text
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(paste0(it$item_text, " "), fp_normal),
|
||
ftext(paste0(" ", stufe_txt, " "), fp_badge),
|
||
ftext(paste0(" ", anker_txt, " [", it$subskala, "]"), fp_text(font.size = 9, color = "#777777"))
|
||
))
|
||
}
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
}
|
||
|
||
andere_module = Filter(function(m) m$id != "hads", erg$module)
|
||
for (mod in andere_module) {
|
||
doc = body_add_fpar(doc, fpar(ftext(mod$titel, fp_abschnitt)))
|
||
if (!is.null(mod$hinweis)) doc = body_add_fpar(doc, fpar(ftext(mod$hinweis, fp_hinweis)))
|
||
|
||
if (mod$id == "paingrid") {
|
||
if (!is.null(mod$daten$n_text)) {
|
||
doc = body_add_fpar(doc, dsf_item_fpar_docx(list(
|
||
label = "Anzahl markierter Rasterfelder", text = mod$daten$n_text,
|
||
wert_num = suppressWarnings(as.numeric(mod$daten$n_text)),
|
||
bereich_min = NA_real_, bereich_max = NA_real_
|
||
), fp_label))
|
||
}
|
||
bild = tryCatch(
|
||
dsf_erstelle_paingrid_bild_datei(mod$daten$zellen, mod$daten$grid_rows, mod$daten$grid_cols),
|
||
error = function(e) NULL
|
||
)
|
||
if (!is.null(bild)) {
|
||
doc = tryCatch(
|
||
body_add_img(doc, src = bild$pfad, width = 3.3, height = 3.3 * bild$breite_zu_hoehe),
|
||
error = function(e) doc
|
||
)
|
||
}
|
||
} else if (mod$id == "slots") {
|
||
for (slot in mod$daten) {
|
||
if (!is.na(slot$titel)) {
|
||
doc = body_add_fpar(doc, fpar(ftext(slot$titel, fp_text(bold = TRUE, font.size = 11, color = "#333333"))))
|
||
}
|
||
for (it in slot$items) {
|
||
doc = body_add_fpar(doc, dsf_item_fpar_docx(it, fp_label))
|
||
}
|
||
}
|
||
} else {
|
||
for (it in mod$daten) {
|
||
doc = body_add_fpar(doc, dsf_item_fpar_docx(it, fp_label))
|
||
}
|
||
}
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
}
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext(DSF_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)))
|
||
}
|
||
})
|
||
|
||
ergebnis_r = eventReactive(input$btn_suchen, {
|
||
|
||
chiffre = toupper(trimws(input$chiffre))
|
||
|
||
if (nchar(trimws(input$pseudonym)) == 0 && nchar(chiffre) == 0) {
|
||
return(list(typ = "leere_eingabe", meldung = "Bitte Chiffre oder Pseudonym eingeben."))
|
||
}
|
||
if (nchar(trimws(input$pseudonym)) == 0 && !grepl("^[A-Z][0-9]{6}$", chiffre)) {
|
||
return(list(typ = "format_fehler", chiffre = chiffre))
|
||
}
|
||
|
||
pfadfehler = character(0)
|
||
if (!file.exists(PFAD_DOWNLOAD_SKRIPT))
|
||
pfadfehler = c(pfadfehler, paste0("Download-Skript nicht gefunden: >>", PFAD_DOWNLOAD_SKRIPT, "<<"))
|
||
if (!file.exists(PFAD_PSEUDONYM_SKRIPT))
|
||
pfadfehler = c(pfadfehler, paste0("Pseudonym-Skript nicht gefunden: >>", PFAD_PSEUDONYM_SKRIPT, "<<"))
|
||
if (length(pfadfehler) > 0) {
|
||
return(list(typ = "skript_fehler",
|
||
meldung = paste("Bitte Pfade am Kopf der app.R anpassen:",
|
||
paste(pfadfehler, collapse = "\n"), sep = "\n")))
|
||
}
|
||
|
||
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(typ = "skript_fehler",
|
||
meldung = paste0("Fehler im Download-Skript (", basename(PFAD_DOWNLOAD_SKRIPT), "):\n", 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
|
||
})
|
||
if (is.null(db_ordner)) {
|
||
return(list(typ = "skript_fehler",
|
||
meldung = paste0(
|
||
"pseudonyme.db nicht gefunden.\n",
|
||
"Gesucht ausgehend vom Pseudonym-Skript-Ordner bis zu 5 Ebenen nach oben.")))
|
||
}
|
||
|
||
alter_wd = getwd()
|
||
on.exit(setwd(alter_wd), add = TRUE)
|
||
setwd(db_ordner)
|
||
|
||
ok = tryCatch({
|
||
source(PFAD_PSEUDONYM_SKRIPT, local = FALSE)
|
||
list(ok = TRUE)
|
||
}, error = function(e) list(ok = FALSE, msg = e$message))
|
||
if (!ok$ok) return(list(typ = "skript_fehler",
|
||
meldung = paste0("Fehler im Pseudonym-Skript (", basename(PFAD_PSEUDONYM_SKRIPT), "):\n", ok$msg)))
|
||
|
||
if (!exists("daten_dsf", envir = .GlobalEnv)) {
|
||
return(list(typ = "skript_fehler",
|
||
meldung = paste0("Objekt 'daten_dsf' fehlt nach dem Sourcen von:\n", PFAD_DOWNLOAD_SKRIPT)))
|
||
}
|
||
if (!exists("pseudo", envir = .GlobalEnv)) {
|
||
return(list(typ = "skript_fehler",
|
||
meldung = paste0("Objekt 'pseudo' fehlt nach dem Sourcen von:\n", PFAD_PSEUDONYM_SKRIPT)))
|
||
}
|
||
|
||
daten = get("daten_dsf", envir = .GlobalEnv)
|
||
pseudo = get("pseudo", envir = .GlobalEnv)
|
||
|
||
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]))
|
||
} else if (nchar(chiffre) == 0) {
|
||
return(list(typ = "pseudonym_nicht_gefunden", pseudonym = trimws(input$pseudonym)))
|
||
}
|
||
}
|
||
|
||
treffer_ps = pseudo[pseudo$chiffre == chiffre, ]
|
||
if (nrow(treffer_ps) == 0) {
|
||
return(list(typ = "chiffre_nicht_gefunden", chiffre = chiffre))
|
||
}
|
||
|
||
alle_session_ids = unique(treffer_ps$pseudonym)
|
||
if (nchar(trimws(input$pseudonym)) > 0) alle_session_ids = trimws(input$pseudonym)
|
||
|
||
if (!("session" %in% names(daten))) {
|
||
return(list(typ = "skript_fehler",
|
||
meldung = "Keine Spalte 'session' in 'daten_dsf' gefunden. Bitte Download-Skript pruefen."))
|
||
}
|
||
|
||
treffer_dat = daten[daten$session %in% alle_session_ids, ]
|
||
if (nrow(treffer_dat) == 0) {
|
||
return(list(typ = "session_nicht_gefunden", chiffre = chiffre,
|
||
session_id = paste(alle_session_ids, collapse = ", ")))
|
||
}
|
||
|
||
info_mehrere = NULL
|
||
if (nrow(treffer_dat) > 1) {
|
||
n = nrow(treffer_dat)
|
||
datums_werte = as.Date(rep(NA, nrow(treffer_dat)))
|
||
for (i in seq_len(nrow(treffer_dat))) {
|
||
datums_werte[i] = dsf_finde_ausfuelldatum(treffer_dat[i, , drop = FALSE])
|
||
}
|
||
if (!all(is.na(datums_werte))) {
|
||
reihenfolge = order(datums_werte, decreasing = TRUE, na.last = TRUE)
|
||
treffer_dat = treffer_dat[reihenfolge, ]
|
||
datums_werte = datums_werte[reihenfolge]
|
||
}
|
||
datum_neu_str = if (!is.na(datums_werte[1])) format(datums_werte[1], "%d.%m.%Y") else "unbekanntem Datum"
|
||
info_mehrere = paste0(
|
||
"Mehrere Ausfuellungen gefunden (", n, " Eintraege). ",
|
||
"Angezeigt wird die neueste vom ", datum_neu_str, "."
|
||
)
|
||
treffer_dat = treffer_dat[1, , drop = FALSE]
|
||
}
|
||
|
||
zeile = treffer_dat[1, , drop = FALSE]
|
||
ausfuelldatum = dsf_finde_ausfuelldatum(zeile)
|
||
datum_str = if (!is.na(ausfuelldatum)) format(ausfuelldatum, "%d.%m.%Y") else
|
||
paste0(format(Sys.Date(), "%d.%m.%Y"), " (Ausfuelldatum nicht ermittelbar)")
|
||
|
||
module = tryCatch(
|
||
dsf_baue_module_liste(daten, zeile),
|
||
error = function(e) list(fehler = e$message)
|
||
)
|
||
if (!is.null(module$fehler)) {
|
||
return(list(typ = "skript_fehler",
|
||
meldung = paste0("Fehler bei der Aufbereitung der Daten: ", module$fehler)))
|
||
}
|
||
|
||
list(
|
||
typ = "ergebnis",
|
||
chiffre = chiffre,
|
||
datum_str = datum_str,
|
||
ausfuelldatum = ausfuelldatum,
|
||
info_mehrere = info_mehrere,
|
||
module = module
|
||
)
|
||
})
|
||
|
||
output$ergebnis_ui = renderUI({
|
||
|
||
if (input$btn_suchen == 0) {
|
||
return(div(class = "start-hinweis",
|
||
"Chiffre oder Pseudonym eingeben und auf \"Auswerten\" klicken."))
|
||
}
|
||
|
||
erg = ergebnis_r()
|
||
|
||
if (erg$typ == "skript_fehler") {
|
||
return(div(class = "alert-fehler",
|
||
tags$h4("Konfigurationsfehler"),
|
||
tags$pre(style = "font-size:0.88em; white-space:pre-wrap;", erg$meldung)))
|
||
}
|
||
if (erg$typ == "leere_eingabe") {
|
||
return(div(class = "alert-warnung", erg$meldung))
|
||
}
|
||
if (erg$typ == "format_fehler") {
|
||
return(div(class = "alert-warnung",
|
||
"Ungueltige Chiffre. Erwartet wird ein Grossbuchstabe gefolgt von 6 Ziffern, z.B. P000123."))
|
||
}
|
||
if (erg$typ == "pseudonym_nicht_gefunden") {
|
||
return(div(class = "alert-fehler",
|
||
tags$h4("Pseudonym nicht gefunden"),
|
||
tags$p("Das Pseudonym ", tags$b(paste0("«", erg$pseudonym, "»")),
|
||
" ist in der Pseudonym-Datenbank nicht vorhanden.")))
|
||
}
|
||
if (erg$typ == "chiffre_nicht_gefunden") {
|
||
return(div(class = "alert-fehler",
|
||
tags$h4("Chiffre nicht gefunden"),
|
||
tags$p("Die Chiffre ", tags$b(paste0("«", erg$chiffre, "»")),
|
||
" ist in der Pseudonymtabelle nicht vorhanden.")))
|
||
}
|
||
if (erg$typ == "session_nicht_gefunden") {
|
||
return(div(class = "alert-fehler",
|
||
tags$h4("Kein DSF-Datensatz gefunden"),
|
||
tags$p("Zur Chiffre ", tags$b(paste0("«", erg$chiffre, "»")),
|
||
" existiert ein Pseudonymeintrag, aber kein Datensatz in ",
|
||
tags$code("daten_dsf"), ".")))
|
||
}
|
||
|
||
hads_mod = Filter(function(m) m$id == "hads", erg$module)
|
||
andere_mods = Filter(function(m) m$id != "hads", erg$module)
|
||
|
||
suizid_block = NULL
|
||
if (length(hads_mod) > 0 && isTRUE(hads_mod[[1]]$daten$suizid_ja)) {
|
||
hd = hads_mod[[1]]$daten
|
||
suizid_block = div(class = "suizid-block",
|
||
tags$h4("Frage 18 - Suizid-Screening"),
|
||
div(class = "antwort-text",
|
||
tags$b(hd$suizid_item_text), tags$br(),
|
||
"Antwort: ", hd$suizid_text
|
||
),
|
||
tags$p(class = "disclaimer",
|
||
"Kein automatisiertes klinisches Urteil, bitte umgehend fachlich abklaeren.")
|
||
)
|
||
}
|
||
|
||
kopf_block = div(class = "abschnitt-karte",
|
||
div(class = "meta-block",
|
||
tags$strong("Chiffre: "), erg$chiffre, " ",
|
||
tags$strong("Ausfuelldatum: "), erg$datum_str
|
||
),
|
||
if (!is.null(erg$info_mehrere)) div(class = "alert-warnung", erg$info_mehrere)
|
||
)
|
||
|
||
hads_block = if (length(hads_mod) > 0) {
|
||
hd = hads_mod[[1]]$daten
|
||
mod_meta = hads_mod[[1]]
|
||
|
||
subskalen_ui = fluidRow(
|
||
column(6,
|
||
div(class = "score-zahl",
|
||
if (is.na(hd$angst_summe)) "n/a" else hd$angst_summe),
|
||
div("Angst-Summe (0-21)", style = "color:#555;"),
|
||
div(style = "font-weight:600; margin-top:4px;", hd$angst_klasse),
|
||
plotOutput("hads_angst_plot", height = "130px")
|
||
),
|
||
column(6,
|
||
div(class = "score-zahl",
|
||
if (is.na(hd$depr_summe)) "n/a" else hd$depr_summe),
|
||
div("Depression-Summe (0-21)", style = "color:#555;"),
|
||
div(style = "font-weight:600; margin-top:4px;", hd$depr_klasse),
|
||
plotOutput("hads_depr_plot", height = "130px")
|
||
)
|
||
)
|
||
|
||
items_ui = lapply(hd$reihenfolge, function(var) {
|
||
it = hd$items[[var]]
|
||
stufe_key = if (!is.na(it$score)) as.character(it$score) else "0"
|
||
stufe_txt = if (is.na(it$score)) "?" else as.character(it$score)
|
||
div(class = "item-zeile",
|
||
div(class = "item-text", it$item_text),
|
||
span(style = "color:#888; font-size:0.85em; margin-right:6px;",
|
||
paste0("(", it$subskala, ") ", if (is.na(it$anker_text)) "" else it$anker_text)),
|
||
span(class = paste0("stufe-badge-", stufe_key), stufe_txt)
|
||
)
|
||
})
|
||
|
||
div(class = "abschnitt-karte",
|
||
div(class = "abschnitt-titel", mod_meta$titel),
|
||
if (!is.null(mod_meta$hinweis)) div(class = "modul-hinweis", mod_meta$hinweis),
|
||
subskalen_ui,
|
||
tags$hr(),
|
||
div(items_ui)
|
||
)
|
||
} else NULL
|
||
|
||
andere_blocks = lapply(andere_mods, function(mod) {
|
||
|
||
inhalt = if (mod$id == "paingrid") {
|
||
tagList(
|
||
if (!is.null(mod$daten$n_text))
|
||
dsf_item_zeile_ui(list(
|
||
label = "Anzahl markierter Rasterfelder", text = mod$daten$n_text,
|
||
wert_num = suppressWarnings(as.numeric(mod$daten$n_text)),
|
||
bereich_min = NA_real_, bereich_max = NA_real_
|
||
)),
|
||
dsf_paingrid_overlay_ui(mod$daten$zellen, mod$daten$grid_rows, mod$daten$grid_cols),
|
||
if (!is.null(mod$daten$data_text))
|
||
tags$details(class = "rohdaten-details",
|
||
tags$summary("Technischer Rohinhalt (paingrid_data)"),
|
||
tags$pre(mod$daten$data_text)
|
||
)
|
||
)
|
||
} else if (mod$id == "slots") {
|
||
lapply(mod$daten, function(slot) {
|
||
div(class = "slot-karte",
|
||
if (!is.na(slot$titel)) div(class = "slot-titel", slot$titel),
|
||
lapply(slot$items, dsf_item_zeile_ui)
|
||
)
|
||
})
|
||
} else {
|
||
lapply(mod$daten, dsf_item_zeile_ui)
|
||
}
|
||
|
||
div(class = "abschnitt-karte",
|
||
div(class = "abschnitt-titel", mod$titel),
|
||
if (!is.null(mod$hinweis)) div(class = "modul-hinweis", mod$hinweis),
|
||
inhalt
|
||
)
|
||
})
|
||
|
||
tagList(
|
||
kopf_block,
|
||
suizid_block,
|
||
hads_block,
|
||
andere_blocks,
|
||
div(class = "disclaimer-text", DSF_DISCLAIMER)
|
||
)
|
||
})
|
||
|
||
output$hads_angst_plot = renderPlot({
|
||
req(input$btn_suchen > 0)
|
||
erg = ergebnis_r()
|
||
req(erg$typ == "ergebnis")
|
||
hads_mod = Filter(function(m) m$id == "hads", erg$module)
|
||
req(length(hads_mod) > 0)
|
||
erstelle_hads_balken(hads_mod[[1]]$daten$angst_summe, 10, "Angst")
|
||
}, bg = "white")
|
||
|
||
output$hads_depr_plot = renderPlot({
|
||
req(input$btn_suchen > 0)
|
||
erg = ergebnis_r()
|
||
req(erg$typ == "ergebnis")
|
||
hads_mod = Filter(function(m) m$id == "hads", erg$module)
|
||
req(length(hads_mod) > 0)
|
||
erstelle_hads_balken(hads_mod[[1]]$daten$depr_summe, 8, "Depression")
|
||
}, bg = "white")
|
||
|
||
output$download_word = downloadHandler(
|
||
filename = function() {
|
||
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||
if (is.null(erg) || is.null(erg$typ) || erg$typ != "ergebnis") return("DSF_Auswertung.docx")
|
||
chiffre_esc = gsub("[^A-Za-z0-9_-]", "_", erg$chiffre)
|
||
ausfuelldatum_fn = if (!is.na(erg$ausfuelldatum)) format(erg$ausfuelldatum, "%Y%m%d") else format(Sys.Date(), "%Y%m%d")
|
||
paste0("DSF_", chiffre_esc, "_", ausfuelldatum_fn, ".docx")
|
||
},
|
||
content = function(file) {
|
||
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||
if (is.null(erg) || is.null(erg$typ) || erg$typ != "ergebnis") {
|
||
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_dsf_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 = ui, server = server)
|