Initial commit
This commit is contained in:
commit
3cba772836
1341 changed files with 532924 additions and 0 deletions
999
SOMS2/app.R
Normal file
999
SOMS2/app.R
Normal file
|
|
@ -0,0 +1,999 @@
|
|||
# Präambel ####
|
||||
|
||||
AKZENT_FARBE = "#8B2635"
|
||||
|
||||
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_soms2.R" # liefert: daten_soms2
|
||||
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R" # liefert: pseudo
|
||||
|
||||
PFAD_NORM_A1 = "normen/soms2_norm_a1_gesunde.csv"
|
||||
PFAD_NORM_A2 = "normen/soms2_norm_a2_patienten.csv"
|
||||
|
||||
SOMS2_ROHWERT_MAX_A1 = 20
|
||||
SOMS2_ROHWERT_MAX_A2 = 40
|
||||
|
||||
SOMS2_DISCLAIMER = paste0(
|
||||
"Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
|
||||
"keine klinische Diagnose. Die Interpretation obliegt der behandelnden Person."
|
||||
)
|
||||
|
||||
SOMS2_BESCHWERDEN_CUTOFF_HINWEIS = paste0(
|
||||
"Ab einem Beschwerdenindex von mindestens 7 im SOMS-2 kann in der Regel von ",
|
||||
"einem starken, beeintraechtigenden Somatisierungssyndrom ausgegangen werden."
|
||||
)
|
||||
|
||||
library(shiny)
|
||||
library(dplyr)
|
||||
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)
|
||||
PFAD_NORM_A1 = normalizePath(absPath(PFAD_NORM_A1), mustWork = FALSE)
|
||||
PFAD_NORM_A2 = normalizePath(absPath(PFAD_NORM_A2), mustWork = FALSE)
|
||||
|
||||
|
||||
# Helper ####
|
||||
|
||||
# Generischer Label-Text-Lookup ueber das labels-Attribut der ORIGINAL-Spalte
|
||||
# (vor Subsetting), damit die Zuordnung Wert -> Text immer aus den Daten selbst
|
||||
# stammt und nie von der konkreten formr-Rohkodierung abhaengt.
|
||||
soms2_get_label_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")
|
||||
if (!is.null(lbl_attr) && length(lbl_attr) > 0) {
|
||||
pos = which(as.vector(lbl_attr) == as.numeric(wert[1]))
|
||||
if (length(pos) > 0) return(trimws(names(lbl_attr)[pos[1]]))
|
||||
}
|
||||
NA_character_
|
||||
}
|
||||
|
||||
# Ordinalrang (0-basiert) ueber die sortierte Position im labels-Attribut,
|
||||
# unabhaengig von der tatsaechlichen formr-Kodierung. Genutzt fuer soms2_54
|
||||
# (0 = "keinmal" ... 4 = "mehr als 12 mal") und soms2_63
|
||||
# (0 = "unter 6 Monate" ... 3 = "ueber 2 Jahre").
|
||||
soms2_ordinal_rang = function(original_col, wert) {
|
||||
if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) return(NA_integer_)
|
||||
lbl_attr = attr(original_col, "labels")
|
||||
if (!is.null(lbl_attr) && length(lbl_attr) > 0) {
|
||||
lbl_sortiert = sort(as.vector(lbl_attr))
|
||||
pos = which(lbl_sortiert == as.numeric(wert[1]))
|
||||
if (length(pos) > 0) return(as.integer(pos[1]) - 1L)
|
||||
}
|
||||
NA_integer_
|
||||
}
|
||||
|
||||
# TRUE nur bei eindeutigem "ja"-Label. NA/fehlend (u.a. showif-bedingtes NA bei
|
||||
# geschlechtsspezifischen Items) wird als "nein" gewertet, nie als Fehler - das
|
||||
# ist fuer die Summenscores korrekt, weil solche Items ohnehin ueber den
|
||||
# dynamischen Maximalwert aus der Zaehlung herausgenommen werden.
|
||||
soms2_ist_ja = function(original_col, wert) {
|
||||
txt = soms2_get_label_text(original_col, wert)
|
||||
if (is.na(txt)) return(FALSE)
|
||||
if (grepl("nein", txt, ignore.case = TRUE)) return(FALSE)
|
||||
grepl("ja", txt, ignore.case = TRUE)
|
||||
}
|
||||
|
||||
# TRUE nur bei explizitem "nein"-Label. Anders als soms2_ist_ja() liefert dies
|
||||
# bei NA FALSE zurueck (Kriterium "Antwort = nein" gilt bei fehlender Antwort
|
||||
# als nicht erfuellt, nicht automatisch als erfuellt).
|
||||
soms2_ist_nein = function(original_col, wert) {
|
||||
txt = soms2_get_label_text(original_col, wert)
|
||||
if (is.na(txt)) return(FALSE)
|
||||
grepl("nein", txt, ignore.case = TRUE)
|
||||
}
|
||||
|
||||
# Geschlecht ausschliesslich ueber das labels-Attribut/den Text abgleichen, nie
|
||||
# ueber hartkodierte Zahlenwerte 1/2 (Kodierung kann je Setup variieren).
|
||||
soms2_geschlecht_text = function(original_col, wert) {
|
||||
txt = soms2_get_label_text(original_col, wert)
|
||||
if (is.na(txt)) return(NA_character_)
|
||||
txt_l = tolower(txt)
|
||||
if (grepl("weib", txt_l)) return("weiblich")
|
||||
if (grepl("männ|maenn", txt_l)) return("maennlich")
|
||||
NA_character_
|
||||
}
|
||||
|
||||
# Entfernt Markdown-Escapes ("1\. Text" -> "1. Text", so liegt das label-
|
||||
# Attribut in der soms2.xlsx vor) und danach die fuehrende Itemnummer samt
|
||||
# Trennzeichen (z.B. "1. " oder "01) ").
|
||||
soms2_clean_item_text = function(text) {
|
||||
if (is.null(text) || length(text) == 0 || is.na(text[1])) return(NA_character_)
|
||||
txt = gsub("\\.", ".", trimws(as.character(text[1])), fixed = TRUE)
|
||||
trimws(sub("^\\d+[.):]?\\s*", "", txt))
|
||||
}
|
||||
|
||||
# Klartext-Fragetext eines Items, Fallback auf den Variablennamen, falls kein
|
||||
# label-Attribut vorhanden ist (z.B. bei einem unvollstaendigen Test-Stub).
|
||||
soms2_item_text = function(daten, item) {
|
||||
txt = soms2_clean_item_text(attr(daten[[item]], "label"))
|
||||
if (is.na(txt)) item else txt
|
||||
}
|
||||
|
||||
# Baut einen Kriteriumsbestandteil: Fragetext, tatsaechlich gegebene Antwort
|
||||
# (Klartext ueber das labels-Attribut) und geforderte Antwort/Kategorie.
|
||||
soms2_kriterium_teil = function(zeile, daten, item, erforderlich) {
|
||||
antwort = soms2_get_label_text(daten[[item]], zeile[[item]])
|
||||
list(
|
||||
text = soms2_item_text(daten, item),
|
||||
antwort = if (is.na(antwort)) "k. A." else antwort,
|
||||
erforderlich = erforderlich
|
||||
)
|
||||
}
|
||||
|
||||
# Zaehlt "ja"-Antworten ueber eine einfache Itemliste (DSM-IV, Beschwerdenindex).
|
||||
soms2_score_items = function(zeile, daten, items) {
|
||||
sum(vapply(items, function(it) soms2_ist_ja(daten[[it]], zeile[[it]]), logical(1)))
|
||||
}
|
||||
|
||||
# Zaehlt Wertungseinheiten: jede Gruppe (ODER-Verknuepfung mehrerer Items)
|
||||
# zaehlt maximal 1 Punkt, auch wenn mehrere Items darin "ja" sind
|
||||
# (ICD-10-Somatisierungsindex, SAD-Index).
|
||||
soms2_score_einheiten = function(zeile, daten, einheiten) {
|
||||
sum(vapply(einheiten, function(gruppe) {
|
||||
any(vapply(gruppe, function(it) soms2_ist_ja(daten[[it]], zeile[[it]]), logical(1)))
|
||||
}, logical(1)))
|
||||
}
|
||||
|
||||
# Prozentrang-Lookup: exakter Rohwert-Match; Rohwerte oberhalb des
|
||||
# Tabellenmaximums erhalten Prozentrang 100 (alle Indizes erreichen dort
|
||||
# bereits 100 in der jeweiligen Norm). Ohne exakten Treffer (sollte bei
|
||||
# Ganzzahl-Scores nicht vorkommen) wird auf den naechstniedrigeren
|
||||
# Tabelleneintrag geruendet.
|
||||
soms2_prozentrang = function(rohwert, norm_tab, spalte, rohwert_max) {
|
||||
if (is.null(rohwert) || length(rohwert) == 0 || is.na(rohwert)) return(NA_integer_)
|
||||
if (rohwert > rohwert_max) return(100L)
|
||||
treffer = norm_tab[norm_tab$rohwert == rohwert, ]
|
||||
if (nrow(treffer) == 0) {
|
||||
kandidaten = norm_tab[norm_tab$rohwert <= rohwert, ]
|
||||
if (nrow(kandidaten) == 0) return(NA_integer_)
|
||||
treffer = kandidaten[which.max(kandidaten$rohwert), ]
|
||||
}
|
||||
as.numeric(treffer[[spalte]][1])
|
||||
}
|
||||
|
||||
# Ermittelt Prozentrang (+ optionale Gesamtnorm-Referenz bei A-1) fuer einen
|
||||
# Index, abhaengig von der gewaehlten Vergleichsnorm und dem Geschlecht.
|
||||
soms2_pr_ergebnis = function(index_key, rohwert, geschlecht, normwahl, norm_a1, norm_a2) {
|
||||
if (identical(normwahl, "patienten")) {
|
||||
spalte = SOMS2_NORM_SPALTEN_A2[[index_key]]
|
||||
pr = soms2_prozentrang(rohwert, norm_a2, spalte, SOMS2_ROHWERT_MAX_A2)
|
||||
return(list(pr = pr, pr_gesamt = NA_integer_))
|
||||
}
|
||||
spalten = SOMS2_NORM_SPALTEN_A1[[index_key]]
|
||||
geschlecht_spalte = if (identical(geschlecht, "weiblich")) spalten$w
|
||||
else if (identical(geschlecht, "maennlich")) spalten$m
|
||||
else spalten$gesamt
|
||||
pr = soms2_prozentrang(rohwert, norm_a1, geschlecht_spalte, SOMS2_ROHWERT_MAX_A1)
|
||||
pr_gesamt = soms2_prozentrang(rohwert, norm_a1, spalten$gesamt, SOMS2_ROHWERT_MAX_A1)
|
||||
list(pr = pr, pr_gesamt = pr_gesamt)
|
||||
}
|
||||
|
||||
# Dynamische Maximalwerte (Abschnitt 4): unbekanntes/fehlendes Geschlecht faellt
|
||||
# konservativ auf den vollen (nicht reduzierten) Maximalwert zurueck.
|
||||
soms2_dsmiv_max = function(geschlecht) {
|
||||
if (identical(geschlecht, "weiblich")) return(33L - 1L)
|
||||
if (identical(geschlecht, "maennlich")) return(33L - 4L)
|
||||
33L
|
||||
}
|
||||
soms2_icd10_max = function(geschlecht) {
|
||||
if (identical(geschlecht, "maennlich")) return(13L)
|
||||
14L
|
||||
}
|
||||
soms2_beschwerden_max = function(geschlecht) {
|
||||
# Beschwerdenindex umfasst alle 53 Items (anders als DSM-IV, das soms2_52
|
||||
# gar nicht enthaelt): bei Maennern sind soms2_48-52 (5 Items) nicht
|
||||
# anwendbar, bei Frauen nur soms2_53 (1 Item).
|
||||
if (identical(geschlecht, "weiblich")) return(53L - 1L)
|
||||
if (identical(geschlecht, "maennlich")) return(53L - 5L)
|
||||
53L
|
||||
}
|
||||
|
||||
# Jedes Kriterium traegt seine Bestandteile (teile - i.d.R. 1, bei der
|
||||
# ODER-Verknuepfung in Kriterium 1 des DSM-IV-Index 2) mit dem tatsaechlichen
|
||||
# Fragetext + der gegebenen Antwort, damit UI und Word-Export die konkrete
|
||||
# Item-Formulierung statt einer blossen Itemnummer anzeigen koennen.
|
||||
soms2_dsmiv_kriterien = function(zeile, daten) {
|
||||
rang54 = soms2_ordinal_rang(daten[["soms2_54"]], zeile[["soms2_54"]])
|
||||
rang63 = soms2_ordinal_rang(daten[["soms2_63"]], zeile[["soms2_63"]])
|
||||
list(
|
||||
list(
|
||||
teile = list(
|
||||
soms2_kriterium_teil(zeile, daten, "soms2_54", "nicht 'keinmal'"),
|
||||
soms2_kriterium_teil(zeile, daten, "soms2_58", "ja")
|
||||
),
|
||||
verknuepfung = "ODER",
|
||||
erfuellt = (!is.na(rang54) && rang54 != 0L) ||
|
||||
soms2_ist_ja(daten[["soms2_58"]], zeile[["soms2_58"]])
|
||||
),
|
||||
list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_55", "nein")),
|
||||
verknuepfung = NULL,
|
||||
erfuellt = soms2_ist_nein(daten[["soms2_55"]], zeile[["soms2_55"]])),
|
||||
list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_62", "ja")),
|
||||
verknuepfung = NULL,
|
||||
erfuellt = soms2_ist_ja(daten[["soms2_62"]], zeile[["soms2_62"]])),
|
||||
list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_63", "'ueber 2 Jahre'")),
|
||||
verknuepfung = NULL,
|
||||
erfuellt = !is.na(rang63) && rang63 == 3L)
|
||||
)
|
||||
}
|
||||
|
||||
soms2_icd10_kriterien = function(zeile, daten) {
|
||||
rang54 = soms2_ordinal_rang(daten[["soms2_54"]], zeile[["soms2_54"]])
|
||||
rang63 = soms2_ordinal_rang(daten[["soms2_63"]], zeile[["soms2_63"]])
|
||||
list(
|
||||
list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_54", "mindestens '3 bis 6 mal'")),
|
||||
verknuepfung = NULL, erfuellt = !is.na(rang54) && rang54 >= 2L),
|
||||
list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_55", "nein")),
|
||||
verknuepfung = NULL, erfuellt = soms2_ist_nein(daten[["soms2_55"]], zeile[["soms2_55"]])),
|
||||
list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_56", "nein")),
|
||||
verknuepfung = NULL, erfuellt = soms2_ist_nein(daten[["soms2_56"]], zeile[["soms2_56"]])),
|
||||
list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_57", "ja")),
|
||||
verknuepfung = NULL, erfuellt = soms2_ist_ja(daten[["soms2_57"]], zeile[["soms2_57"]])),
|
||||
list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_61", "nein")),
|
||||
verknuepfung = NULL, erfuellt = soms2_ist_nein(daten[["soms2_61"]], zeile[["soms2_61"]])),
|
||||
list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_63", "'ueber 2 Jahre'")),
|
||||
verknuepfung = NULL, erfuellt = !is.na(rang63) && rang63 == 3L)
|
||||
)
|
||||
}
|
||||
|
||||
soms2_sad_kriterien = function(zeile, daten) {
|
||||
list(
|
||||
list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_55", "nein")),
|
||||
verknuepfung = NULL, erfuellt = soms2_ist_nein(daten[["soms2_55"]], zeile[["soms2_55"]])),
|
||||
list(teile = list(soms2_kriterium_teil(zeile, daten, "soms2_61", "nein")),
|
||||
verknuepfung = NULL, erfuellt = soms2_ist_nein(daten[["soms2_61"]], zeile[["soms2_61"]]))
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
# Datenaufbereitung ####
|
||||
|
||||
if (!file.exists(PFAD_NORM_A1)) {
|
||||
stop(paste0(
|
||||
"Normtabelle (Gesunde) nicht gefunden: ", PFAD_NORM_A1,
|
||||
". Bitte die Datei soms2_norm_a1_gesunde.csv in den Unterordner 'normen/' legen."
|
||||
))
|
||||
}
|
||||
if (!file.exists(PFAD_NORM_A2)) {
|
||||
stop(paste0(
|
||||
"Normtabelle (Patienten) nicht gefunden: ", PFAD_NORM_A2,
|
||||
". Bitte die Datei soms2_norm_a2_patienten.csv in den Unterordner 'normen/' legen."
|
||||
))
|
||||
}
|
||||
|
||||
soms2_norm_a1 = read.csv(PFAD_NORM_A1, stringsAsFactors = FALSE)
|
||||
soms2_norm_a2 = read.csv(PFAD_NORM_A2, stringsAsFactors = FALSE)
|
||||
|
||||
# Somatisierungsindex DSM-IV: 33 Items, soms2_53 nur bei Frauen erhoben,
|
||||
# soms2_48-51 nur bei Maennern erhoben (showif in formr).
|
||||
SOMS2_DSMIV_ITEMS = sprintf("soms2_%02d", c(
|
||||
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 16, 20, 32, 34, 35,
|
||||
36, 37, 38, 39, 40, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 53
|
||||
))
|
||||
|
||||
# Somatisierungsindex ICD-10: 14 Wertungseinheiten (ODER-Gruppen), Einheit 14
|
||||
# (soms2_52) nur bei Frauen anwendbar.
|
||||
SOMS2_ICD10_EINHEITEN = list(
|
||||
"soms2_02",
|
||||
c("soms2_04", "soms2_05"),
|
||||
"soms2_06",
|
||||
c("soms2_09", "soms2_22", "soms2_38"),
|
||||
"soms2_10",
|
||||
"soms2_11",
|
||||
c("soms2_13", "soms2_14"),
|
||||
"soms2_18",
|
||||
c("soms2_20", "soms2_21"),
|
||||
"soms2_28",
|
||||
"soms2_31",
|
||||
"soms2_33",
|
||||
c("soms2_40", "soms2_41"),
|
||||
"soms2_52"
|
||||
)
|
||||
|
||||
# SAD-Index ICD-10: 12 Wertungseinheiten, keine Geschlechtertrennung.
|
||||
SOMS2_SAD_EINHEITEN = list(
|
||||
c("soms2_06", "soms2_25"),
|
||||
"soms2_11",
|
||||
"soms2_12",
|
||||
"soms2_15",
|
||||
"soms2_19",
|
||||
c("soms2_09", "soms2_22", "soms2_38"),
|
||||
"soms2_23",
|
||||
"soms2_24",
|
||||
"soms2_26",
|
||||
"soms2_27",
|
||||
c("soms2_28", "soms2_29"),
|
||||
"soms2_30"
|
||||
)
|
||||
|
||||
# Beschwerdenindex Somatisierung: alle Items soms2_01-soms2_53, keine Auswahl.
|
||||
SOMS2_BESCHWERDEN_ITEMS = sprintf("soms2_%02d", 1:53)
|
||||
|
||||
# Zusatz-Screeningitems 64-68: 65/67 sind Folgefragen zu 64/66, 68 steht
|
||||
# alleine. Reine Einzelitem-Anzeige, kein Score.
|
||||
SOMS2_ZUSATZ_ITEMS = list(
|
||||
list(haupt = "soms2_64", folge = "soms2_65"),
|
||||
list(haupt = "soms2_66", folge = "soms2_67"),
|
||||
list(haupt = "soms2_68", folge = NULL)
|
||||
)
|
||||
|
||||
# Spaltenzuordnung fuer die Prozentrang-Lookups je Normtabelle.
|
||||
SOMS2_NORM_SPALTEN_A1 = list(
|
||||
dsmiv = list(gesamt = "dsmiv_gesamt", m = "dsmiv_m", w = "dsmiv_w"),
|
||||
icd10 = list(gesamt = "icd10_gesamt", m = "icd10_m", w = "icd10_w"),
|
||||
sad = list(gesamt = "sad_gesamt", m = "sad_m", w = "sad_w"),
|
||||
beschwerden = list(gesamt = "beschwerdenindex_gesamt", m = "beschwerdenindex_m", w = "beschwerdenindex_w")
|
||||
)
|
||||
SOMS2_NORM_SPALTEN_A2 = list(
|
||||
dsmiv = "dsmiv",
|
||||
icd10 = "icd10",
|
||||
sad = "sad",
|
||||
beschwerden = "beschwerdenindex_gesamt"
|
||||
)
|
||||
|
||||
|
||||
# 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: flex-start; gap: 10px;
|
||||
padding: 7px 0; border-bottom: 1px solid #F0F0F0;
|
||||
}
|
||||
.item-zeile.item-unterpunkt { padding-left: 28px; border-bottom: none; }
|
||||
.item-nr { font-weight: 600; color: #8B2635; min-width: 34px; flex-shrink: 0; }
|
||||
.item-text { flex: 1; color: #333; font-size: 0.92em; }
|
||||
.kriterien-liste { margin: 10px 0; padding: 0; list-style: none; }
|
||||
.kriterium-zeile {
|
||||
display: flex; align-items: flex-start; gap: 10px; padding: 8px 0;
|
||||
border-bottom: 1px solid #F5F5F5; font-size: 0.92em; color: #444;
|
||||
}
|
||||
.kriterium-status { font-weight: 700; min-width: 100px; flex-shrink: 0; }
|
||||
.kriterium-erfuellt { color: #2E7D32; }
|
||||
.kriterium-nicht-erfuellt { color: #B71C1C; }
|
||||
.kriterium-inhalt { flex: 1; display: flex; flex-direction: column; gap: 2px; }
|
||||
.kriterium-frage { color: #333; }
|
||||
.kriterium-antwort { color: #777; font-size: 0.85em; }
|
||||
.kriterium-verknuepfung {
|
||||
font-size: 0.78em; color: #999; font-style: italic; margin: 2px 0;
|
||||
}
|
||||
.gesamtstatus-box {
|
||||
border-radius: 6px; padding: 12px 16px; margin-top: 10px;
|
||||
font-weight: 700; border-left: 5px solid;
|
||||
}
|
||||
.gesamtstatus-erfuellt { background: #E8F5E9; border-color: #2E7D32; color: #2E7D32; }
|
||||
.gesamtstatus-nicht-erfuellt { background: #F5F5F5; border-color: #9E9E9E; color: #616161; }
|
||||
.score-zahl { font-size: 2.2rem; font-weight: 800; color: #8B2635; }
|
||||
.score-label { color: #555; font-size: 0.9em; }
|
||||
.pr-info { color: #555; font-size: 0.9em; margin-top: 4px; }
|
||||
.cutoff-hinweis {
|
||||
background: #FFF3E0; border-left: 5px solid #E65100; color: #BF360C;
|
||||
padding: 10px 14px; border-radius: 4px; margin-top: 10px; font-size: 0.9em;
|
||||
}
|
||||
.normwahl-hinweis { color: #777; font-size: 0.82em; font-style: italic; margin-top: 6px; }
|
||||
.start-hinweis { text-align: center; color: #bbb; padding: 30px 0; font-style: italic; }
|
||||
"
|
||||
|
||||
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("SOMS-2 - Screening fuer somatoforme Stoerungen (2-Jahres-Version)"),
|
||||
tags$p("Rief, Hiller & Heuser 1997 | Vier parallele Auswertungskennwerte")
|
||||
),
|
||||
|
||||
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)")
|
||||
)
|
||||
),
|
||||
|
||||
div(class = "input-panel",
|
||||
div(
|
||||
tags$label("Vergleichsnorm",
|
||||
style = "font-weight:600; color:#333; display:block; margin-bottom:4px;"),
|
||||
radioButtons("normwahl", label = NULL,
|
||||
choices = c("Gesunde" = "gesunde", "psychosomatische Patienten" = "patienten"),
|
||||
selected = "gesunde", inline = TRUE)
|
||||
),
|
||||
uiOutput("normwahl_hinweis_ui")
|
||||
),
|
||||
|
||||
uiOutput("ergebnis_ui")
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
# Word-Export ####
|
||||
|
||||
erstelle_soms2_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_erfuellt = fp_text(font.size = 10, bold = TRUE, color = "#2E7D32")
|
||||
fp_nicht = fp_text(font.size = 10, bold = TRUE, color = "#B71C1C")
|
||||
fp_gesamt_ok = fp_text(font.size = 11, bold = TRUE, color = "#2E7D32")
|
||||
fp_gesamt_nok = fp_text(font.size = 11, bold = TRUE, color = "#616161")
|
||||
fp_cutoff = fp_text(font.size = 10, italic = TRUE, color = "#BF360C")
|
||||
fp_warnung = fp_text(font.size = 10, italic = TRUE, color = "#8a6d00")
|
||||
fp_normhinweis = fp_text(font.size = 9.5, italic = TRUE, color = "#555555")
|
||||
fp_antwort = fp_text(font.size = 9.5, color = "#777777")
|
||||
fp_verknuepfung = fp_text(font.size = 9, italic = TRUE, color = "#999999")
|
||||
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("SOMS-2 - 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),
|
||||
ftext(" Geschlecht: ", fp_label),
|
||||
ftext(if (is.na(erg$geschlecht_text)) "k. A." else erg$geschlecht_text, fp_normal)
|
||||
))
|
||||
if (!is.null(erg$warnung_daten)) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(erg$warnung_daten, fp_warnung)))
|
||||
}
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
if (identical(erg$normwahl, "patienten"))
|
||||
"Vergleichsnorm: psychosomatische Patienten (nicht nach Geschlecht getrennt)"
|
||||
else
|
||||
"Vergleichsnorm: Gesunde",
|
||||
fp_normhinweis
|
||||
)))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
for (idx in erg$indizes) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(idx$titel, fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Rohwert: ", fp_label),
|
||||
ftext(paste0(idx$rohwert, " / ", idx$max), fp_normal),
|
||||
ftext(" Prozentrang: ", fp_label),
|
||||
ftext(if (is.na(idx$pr)) "k. A." else paste0(idx$pr), fp_normal)
|
||||
))
|
||||
if (!is.null(idx$kriterien)) {
|
||||
for (k in idx$kriterien) {
|
||||
status_txt = if (isTRUE(k$erfuellt)) "[erfuellt] " else "[nicht erfuellt] "
|
||||
status_fp = if (isTRUE(k$erfuellt)) fp_erfuellt else fp_nicht
|
||||
for (i in seq_along(k$teile)) {
|
||||
teil = k$teile[[i]]
|
||||
if (i == 1) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(status_txt, status_fp), ftext(teil$text, fp_normal)))
|
||||
} else {
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(" ", k$verknuepfung, " "), fp_verknuepfung),
|
||||
ftext(teil$text, fp_normal)
|
||||
))
|
||||
}
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
paste0(" Antwort: ", teil$antwort, " (erforderlich: ", teil$erforderlich, ")"),
|
||||
fp_antwort
|
||||
)))
|
||||
}
|
||||
}
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
if (isTRUE(idx$gesamtstatus)) "Kriterien fuer Verdachtsdiagnose erfuellt"
|
||||
else "Kriterien fuer Verdachtsdiagnose nicht (vollstaendig) erfuellt",
|
||||
if (isTRUE(idx$gesamtstatus)) fp_gesamt_ok else fp_gesamt_nok
|
||||
)))
|
||||
}
|
||||
if (!is.null(idx$cutoff_hinweis)) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(idx$cutoff_hinweis, fp_cutoff)))
|
||||
}
|
||||
if (identical(idx$key, "beschwerden")) {
|
||||
if (length(erg$beschwerden_ja_items) > 0) {
|
||||
doc = body_add_fpar(doc, fpar(ftext("Angegebene Beschwerden (mit 'ja' beantwortet):", fp_label)))
|
||||
for (b in erg$beschwerden_ja_items) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(paste0(b$nr, ". ", b$text), fp_normal)))
|
||||
}
|
||||
} else {
|
||||
doc = body_add_fpar(doc, fpar(ftext("Keine der 53 Beschwerden wurde mit 'ja' beantwortet.", fp_normal)))
|
||||
}
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
}
|
||||
|
||||
if (length(erg$screening_hinweise) > 0) {
|
||||
doc = body_add_fpar(doc, fpar(ftext("Weitere Screening-Hinweise", fp_abschnitt)))
|
||||
for (h in erg$screening_hinweise) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(paste0(h$nr, ". ", h$text), fp_normal)))
|
||||
if (!is.null(h$folge_text)) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(paste0(" -> ", h$folge_text), fp_normal)))
|
||||
}
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
}
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext(SOMS2_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)))
|
||||
}
|
||||
})
|
||||
|
||||
rohdaten_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))
|
||||
}
|
||||
|
||||
if (!file.exists(PFAD_DOWNLOAD_SKRIPT)) {
|
||||
return(list(typ = "skript_fehler",
|
||||
meldung = paste0("Download-Skript nicht gefunden: ", PFAD_DOWNLOAD_SKRIPT)))
|
||||
}
|
||||
if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) {
|
||||
return(list(typ = "skript_fehler",
|
||||
meldung = paste0("Pseudonym-Skript nicht gefunden: ", PFAD_PSEUDONYM_SKRIPT)))
|
||||
}
|
||||
|
||||
ok = tryCatch({
|
||||
source(PFAD_DOWNLOAD_SKRIPT, local = FALSE)
|
||||
list(ok = TRUE)
|
||||
}, error = function(e) list(ok = FALSE, msg = e$message))
|
||||
if (!ok$ok) return(list(typ = "skript_fehler", meldung = 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 = "pseudonyme.db wurde ausgehend vom Pseudonym-Skript-Ordner bis zu 5 Ebenen nach oben nicht gefunden."))
|
||||
}
|
||||
|
||||
alter_wd = getwd()
|
||||
on.exit(setwd(alter_wd), add = TRUE)
|
||||
setwd(db_ordner)
|
||||
|
||||
ok_ps = tryCatch({
|
||||
source(PFAD_PSEUDONYM_SKRIPT, local = FALSE)
|
||||
list(ok = TRUE)
|
||||
}, error = function(e) list(ok = FALSE, msg = e$message))
|
||||
if (!ok_ps$ok) return(list(typ = "skript_fehler", meldung = ok_ps$msg))
|
||||
|
||||
if (!exists("daten_soms2", envir = .GlobalEnv)) {
|
||||
return(list(typ = "skript_fehler",
|
||||
meldung = "Objekt 'daten_soms2' wurde nach dem Sourcen des Download-Skripts nicht gefunden."))
|
||||
}
|
||||
if (!exists("pseudo", envir = .GlobalEnv)) {
|
||||
return(list(typ = "skript_fehler",
|
||||
meldung = "Objekt 'pseudo' wurde nach dem Sourcen des Pseudonym-Skripts nicht gefunden."))
|
||||
}
|
||||
|
||||
daten_soms2 = get("daten_soms2", 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]))
|
||||
}
|
||||
|
||||
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)
|
||||
|
||||
treffer_dat = daten_soms2[daten_soms2$session %in% alle_session_ids, ]
|
||||
if (nrow(treffer_dat) == 0) {
|
||||
return(list(typ = "session_nicht_gefunden", chiffre = chiffre))
|
||||
}
|
||||
|
||||
warnung_daten = NULL
|
||||
if (nrow(treffer_dat) > 1) {
|
||||
n = nrow(treffer_dat)
|
||||
treffer_dat = treffer_dat[order(treffer_dat$created, decreasing = TRUE), ]
|
||||
datum_neu = tryCatch(
|
||||
format(as.POSIXct(treffer_dat$created[1]), "%d.%m.%Y %H:%M"),
|
||||
error = function(e) "unbekanntes Datum"
|
||||
)
|
||||
warnung_daten = paste0(
|
||||
"Mehrere Ausfuellungen gefunden (", n, " Eintraege). ",
|
||||
"Angezeigt wird die neueste vom ", datum_neu, "."
|
||||
)
|
||||
treffer_dat = treffer_dat[1, , drop = FALSE]
|
||||
}
|
||||
|
||||
zeile = treffer_dat[1, , drop = FALSE]
|
||||
datum_str = tryCatch(
|
||||
format(as.POSIXct(zeile[["created"]][1]), "%d.%m.%Y"),
|
||||
error = function(e) format(Sys.Date(), "%d.%m.%Y")
|
||||
)
|
||||
|
||||
geschlecht_text = soms2_geschlecht_text(daten_soms2[["soms2_geschlecht"]], zeile[["soms2_geschlecht"]])
|
||||
|
||||
dsmiv_rohwert = soms2_score_items(zeile, daten_soms2, SOMS2_DSMIV_ITEMS)
|
||||
dsmiv_max = soms2_dsmiv_max(geschlecht_text)
|
||||
dsmiv_krit = soms2_dsmiv_kriterien(zeile, daten_soms2)
|
||||
|
||||
icd10_rohwert = soms2_score_einheiten(zeile, daten_soms2, SOMS2_ICD10_EINHEITEN)
|
||||
icd10_max = soms2_icd10_max(geschlecht_text)
|
||||
icd10_krit = soms2_icd10_kriterien(zeile, daten_soms2)
|
||||
|
||||
sad_rohwert = soms2_score_einheiten(zeile, daten_soms2, SOMS2_SAD_EINHEITEN)
|
||||
sad_max = 12L
|
||||
sad_krit = soms2_sad_kriterien(zeile, daten_soms2)
|
||||
|
||||
beschwerden_rohwert = soms2_score_items(zeile, daten_soms2, SOMS2_BESCHWERDEN_ITEMS)
|
||||
beschwerden_max = soms2_beschwerden_max(geschlecht_text)
|
||||
|
||||
# Liste der einzelnen mit "ja" beantworteten Beschwerden (Items 1-53) fuer
|
||||
# die Anzeige unter dem Beschwerdenindex.
|
||||
beschwerden_ja_items = list()
|
||||
for (it in SOMS2_BESCHWERDEN_ITEMS) {
|
||||
if (isTRUE(soms2_ist_ja(daten_soms2[[it]], zeile[[it]]))) {
|
||||
beschwerden_ja_items[[length(beschwerden_ja_items) + 1]] = list(
|
||||
nr = as.integer(sub("^soms2_", "", it)),
|
||||
text = soms2_item_text(daten_soms2, it)
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
screening_hinweise = list()
|
||||
for (paar in SOMS2_ZUSATZ_ITEMS) {
|
||||
if (isTRUE(soms2_ist_ja(daten_soms2[[paar$haupt]], zeile[[paar$haupt]]))) {
|
||||
folge_text = NULL
|
||||
if (!is.null(paar$folge) && isTRUE(soms2_ist_ja(daten_soms2[[paar$folge]], zeile[[paar$folge]]))) {
|
||||
folge_text = soms2_item_text(daten_soms2, paar$folge)
|
||||
}
|
||||
screening_hinweise[[length(screening_hinweise) + 1]] = list(
|
||||
nr = as.integer(sub("^soms2_", "", paar$haupt)),
|
||||
text = soms2_item_text(daten_soms2, paar$haupt),
|
||||
folge_text = folge_text
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
list(
|
||||
typ = "ergebnis",
|
||||
chiffre = chiffre,
|
||||
datum_str = datum_str,
|
||||
warnung_daten = warnung_daten,
|
||||
geschlecht_text = geschlecht_text,
|
||||
dsmiv_rohwert = dsmiv_rohwert, dsmiv_max = dsmiv_max, dsmiv_krit = dsmiv_krit,
|
||||
icd10_rohwert = icd10_rohwert, icd10_max = icd10_max, icd10_krit = icd10_krit,
|
||||
sad_rohwert = sad_rohwert, sad_max = sad_max, sad_krit = sad_krit,
|
||||
beschwerden_rohwert = beschwerden_rohwert, beschwerden_max = beschwerden_max,
|
||||
beschwerden_ja_items = beschwerden_ja_items,
|
||||
screening_hinweise = screening_hinweise
|
||||
)
|
||||
})
|
||||
|
||||
# Leichtgewichtiges reactive() statt eventReactive: die Prozentraenge sollen
|
||||
# sich sofort aktualisieren, wenn die Vergleichsnorm umgeschaltet wird, ohne
|
||||
# dass erneut "Auswerten" geklickt werden muss (Rohdaten/Kriterien bleiben
|
||||
# dabei unveraendert, nur der Normtabellen-Lookup wird neu berechnet).
|
||||
ergebnis_r = reactive({
|
||||
d = rohdaten_r()
|
||||
if (d$typ != "ergebnis") return(d)
|
||||
|
||||
normwahl = input$normwahl
|
||||
if (is.null(normwahl)) normwahl = "gesunde"
|
||||
|
||||
dsmiv_pr = soms2_pr_ergebnis("dsmiv", d$dsmiv_rohwert, d$geschlecht_text, normwahl, soms2_norm_a1, soms2_norm_a2)
|
||||
icd10_pr = soms2_pr_ergebnis("icd10", d$icd10_rohwert, d$geschlecht_text, normwahl, soms2_norm_a1, soms2_norm_a2)
|
||||
sad_pr = soms2_pr_ergebnis("sad", d$sad_rohwert, d$geschlecht_text, normwahl, soms2_norm_a1, soms2_norm_a2)
|
||||
besch_pr = soms2_pr_ergebnis("beschwerden", d$beschwerden_rohwert, d$geschlecht_text, normwahl, soms2_norm_a1, soms2_norm_a2)
|
||||
|
||||
indizes = list(
|
||||
list(
|
||||
key = "dsmiv", titel = "Somatisierungsindex DSM-IV",
|
||||
rohwert = d$dsmiv_rohwert, max = d$dsmiv_max,
|
||||
pr = dsmiv_pr$pr, pr_gesamt = dsmiv_pr$pr_gesamt,
|
||||
kriterien = d$dsmiv_krit,
|
||||
gesamtstatus = all(vapply(d$dsmiv_krit, function(k) isTRUE(k$erfuellt), logical(1))),
|
||||
cutoff_hinweis = NULL
|
||||
),
|
||||
list(
|
||||
key = "icd10", titel = "Somatisierungsindex ICD-10",
|
||||
rohwert = d$icd10_rohwert, max = d$icd10_max,
|
||||
pr = icd10_pr$pr, pr_gesamt = icd10_pr$pr_gesamt,
|
||||
kriterien = d$icd10_krit,
|
||||
gesamtstatus = all(vapply(d$icd10_krit, function(k) isTRUE(k$erfuellt), logical(1))),
|
||||
cutoff_hinweis = NULL
|
||||
),
|
||||
list(
|
||||
key = "sad", titel = "SAD-Index ICD-10",
|
||||
rohwert = d$sad_rohwert, max = d$sad_max,
|
||||
pr = sad_pr$pr, pr_gesamt = sad_pr$pr_gesamt,
|
||||
kriterien = d$sad_krit,
|
||||
gesamtstatus = all(vapply(d$sad_krit, function(k) isTRUE(k$erfuellt), logical(1))),
|
||||
cutoff_hinweis = NULL
|
||||
),
|
||||
list(
|
||||
key = "beschwerden", titel = "Beschwerdenindex Somatisierung",
|
||||
rohwert = d$beschwerden_rohwert, max = d$beschwerden_max,
|
||||
pr = besch_pr$pr, pr_gesamt = besch_pr$pr_gesamt,
|
||||
kriterien = NULL,
|
||||
gesamtstatus = NA,
|
||||
cutoff_hinweis = if (isTRUE(d$beschwerden_rohwert >= 7)) SOMS2_BESCHWERDEN_CUTOFF_HINWEIS else NULL
|
||||
)
|
||||
)
|
||||
|
||||
c(d, list(normwahl = normwahl, indizes = indizes))
|
||||
})
|
||||
|
||||
output$normwahl_hinweis_ui = renderUI({
|
||||
if (identical(input$normwahl, "patienten")) {
|
||||
div(class = "normwahl-hinweis",
|
||||
"Die Patientennorm liegt nicht nach Geschlecht getrennt vor (eine Vergleichsgruppe fuer alle).")
|
||||
} else {
|
||||
NULL
|
||||
}
|
||||
})
|
||||
|
||||
output$ergebnis_ui = renderUI({
|
||||
|
||||
if (input$btn_suchen == 0) {
|
||||
return(div(class = "abschnitt-karte start-hinweis",
|
||||
"Bitte Chiffre oder Pseudonym eingeben und auf 'Auswerten' klicken."
|
||||
))
|
||||
}
|
||||
|
||||
erg = ergebnis_r()
|
||||
|
||||
if (erg$typ == "leere_eingabe") {
|
||||
return(div(class = "alert-warnung", erg$meldung))
|
||||
}
|
||||
if (erg$typ == "format_fehler") {
|
||||
return(div(class = "alert-warnung",
|
||||
paste0("Ungueltige Chiffre '", erg$chiffre, "'. Erwartet: ein Grossbuchstabe gefolgt von 6 Ziffern (z. B. P000123).")))
|
||||
}
|
||||
if (erg$typ == "skript_fehler") {
|
||||
return(div(class = "alert-fehler", tags$pre(style = "white-space:pre-wrap; margin:0;", erg$meldung)))
|
||||
}
|
||||
if (erg$typ == "chiffre_nicht_gefunden") {
|
||||
return(div(class = "alert-fehler",
|
||||
paste0("Chiffre '", erg$chiffre, "' wurde in der Pseudonym-Datenbank nicht gefunden.")))
|
||||
}
|
||||
if (erg$typ == "session_nicht_gefunden") {
|
||||
return(div(class = "alert-fehler",
|
||||
paste0("Kein SOMS-2-Datensatz fuer Chiffre '", erg$chiffre, "' gefunden.")))
|
||||
}
|
||||
|
||||
meta_block = div(class = "meta-block",
|
||||
tags$strong("Chiffre: "), erg$chiffre, " ",
|
||||
tags$strong("Ausfuelldatum: "), erg$datum_str, " ",
|
||||
tags$strong("Geschlecht: "), if (is.na(erg$geschlecht_text)) "k. A." else erg$geschlecht_text
|
||||
)
|
||||
|
||||
kopf_karte = div(class = "abschnitt-karte",
|
||||
meta_block,
|
||||
if (!is.null(erg$warnung_daten)) div(class = "alert-warnung", erg$warnung_daten) else NULL
|
||||
)
|
||||
|
||||
index_karten = lapply(erg$indizes, function(idx) {
|
||||
|
||||
pr_text = if (is.na(idx$pr)) "k. A." else paste0(idx$pr)
|
||||
pr_zusatz = if (!identical(erg$normwahl, "patienten") &&
|
||||
!is.na(erg$geschlecht_text) &&
|
||||
!is.na(idx$pr_gesamt))
|
||||
paste0(" (Gesamtnorm: ", idx$pr_gesamt, ")") else ""
|
||||
|
||||
kriterien_ui = if (!is.null(idx$kriterien)) {
|
||||
tagList(
|
||||
div(class = "kriterien-liste",
|
||||
lapply(idx$kriterien, function(k) {
|
||||
teile_ui = lapply(seq_along(k$teile), function(i) {
|
||||
teil = k$teile[[i]]
|
||||
tagList(
|
||||
if (i > 1) div(class = "kriterium-verknuepfung", k$verknuepfung) else NULL,
|
||||
div(class = "kriterium-frage", teil$text),
|
||||
div(class = "kriterium-antwort",
|
||||
paste0("Antwort: ", teil$antwort, " (erforderlich: ", teil$erforderlich, ")"))
|
||||
)
|
||||
})
|
||||
div(class = "kriterium-zeile",
|
||||
span(class = paste0("kriterium-status ",
|
||||
if (isTRUE(k$erfuellt)) "kriterium-erfuellt" else "kriterium-nicht-erfuellt"),
|
||||
if (isTRUE(k$erfuellt)) "erfuellt" else "nicht erfuellt"),
|
||||
div(class = "kriterium-inhalt", teile_ui)
|
||||
)
|
||||
})
|
||||
),
|
||||
div(class = paste0("gesamtstatus-box ",
|
||||
if (isTRUE(idx$gesamtstatus)) "gesamtstatus-erfuellt" else "gesamtstatus-nicht-erfuellt"),
|
||||
if (isTRUE(idx$gesamtstatus)) "Kriterien fuer Verdachtsdiagnose erfuellt"
|
||||
else "Kriterien fuer Verdachtsdiagnose nicht (vollstaendig) erfuellt")
|
||||
)
|
||||
} else NULL
|
||||
|
||||
cutoff_ui = if (!is.null(idx$cutoff_hinweis)) div(class = "cutoff-hinweis", idx$cutoff_hinweis) else NULL
|
||||
|
||||
beschwerden_liste_ui = if (identical(idx$key, "beschwerden")) {
|
||||
if (length(erg$beschwerden_ja_items) > 0) {
|
||||
tagList(
|
||||
tags$h5("Angegebene Beschwerden (mit 'ja' beantwortet)",
|
||||
style = "margin-top:14px; margin-bottom:6px; color:#555; font-size:0.95em;"),
|
||||
lapply(erg$beschwerden_ja_items, function(b) {
|
||||
div(class = "item-zeile",
|
||||
div(class = "item-nr", paste0(b$nr, ".")),
|
||||
div(class = "item-text", b$text)
|
||||
)
|
||||
})
|
||||
)
|
||||
} else {
|
||||
div(class = "normwahl-hinweis",
|
||||
"Keine der 53 Beschwerden wurde mit 'ja' beantwortet.")
|
||||
}
|
||||
} else NULL
|
||||
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", idx$titel),
|
||||
div(
|
||||
span(class = "score-zahl", idx$rohwert),
|
||||
span(class = "score-label", paste0(" / ", idx$max))
|
||||
),
|
||||
div(class = "pr-info", paste0("Prozentrang: ", pr_text, pr_zusatz)),
|
||||
kriterien_ui,
|
||||
cutoff_ui,
|
||||
beschwerden_liste_ui
|
||||
)
|
||||
})
|
||||
|
||||
hinweise_karte = if (length(erg$screening_hinweise) > 0) {
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "Weitere Screening-Hinweise"),
|
||||
lapply(erg$screening_hinweise, function(h) {
|
||||
tagList(
|
||||
div(class = "item-zeile",
|
||||
div(class = "item-nr", paste0(h$nr, ".")),
|
||||
div(class = "item-text", h$text)
|
||||
),
|
||||
if (!is.null(h$folge_text))
|
||||
div(class = "item-zeile item-unterpunkt",
|
||||
div(class = "item-text", h$folge_text))
|
||||
else NULL
|
||||
)
|
||||
})
|
||||
)
|
||||
} else NULL
|
||||
|
||||
tagList(kopf_karte, index_karten, hinweise_karte)
|
||||
})
|
||||
|
||||
output$download_word = downloadHandler(
|
||||
filename = function() {
|
||||
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
if (is.null(erg) || erg$typ != "ergebnis") return("SOMS2_Export.docx")
|
||||
chiffre_esc = gsub("[^A-Za-z0-9_-]", "_", erg$chiffre)
|
||||
ausfuelldatum_fn = tryCatch(
|
||||
format(as.Date(erg$datum_str, "%d.%m.%Y"), "%Y%m%d"),
|
||||
error = function(e) format(Sys.Date(), "%Y%m%d")
|
||||
)
|
||||
paste0("SOMS2_", chiffre_esc, "_", ausfuelldatum_fn, ".docx")
|
||||
},
|
||||
content = function(file) {
|
||||
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
if (is.null(erg) || 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_soms2_docx(erg),
|
||||
error = function(e) {
|
||||
err_doc = read_docx()
|
||||
body_add_par(err_doc,
|
||||
paste0("Fehler beim Erstellen des Word-Dokuments: ", e$message),
|
||||
style = "Normal")
|
||||
}
|
||||
)
|
||||
print(doc, target = file)
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
# Start ####
|
||||
|
||||
shinyApp(ui, server)
|
||||
Loading…
Add table
Add a link
Reference in a new issue