Initial commit
This commit is contained in:
commit
3cba772836
1341 changed files with 532924 additions and 0 deletions
795
SOMS-7T/app.R
Normal file
795
SOMS-7T/app.R
Normal file
|
|
@ -0,0 +1,795 @@
|
|||
# Präambel ####
|
||||
|
||||
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_soms7t.R" # liefert: daten_soms7t
|
||||
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R" # liefert: pseudo
|
||||
AKZENT_FARBE = "#8B2635"
|
||||
|
||||
PFAD_NORM_B1 = "normen/soms7t_norm_b1_patienten.csv"
|
||||
PFAD_NORM_B2 = "normen/soms7t_norm_b2_beschwerdenanzahl_gesunde.csv"
|
||||
PFAD_NORM_B3 = "normen/soms7t_norm_b3_dsmiv_gesunde.csv"
|
||||
PFAD_NORM_B4 = "normen/soms7t_norm_b4_intensitaet_gesunde.csv"
|
||||
PFAD_NORM_B5 = "normen/soms7t_norm_b5_nach_staerke_gesunde.csv"
|
||||
|
||||
SOMS7T_DISCLAIMER = paste0(
|
||||
"Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
|
||||
"keine klinische Diagnose. Die Interpretation obliegt der behandelnden Person."
|
||||
)
|
||||
|
||||
SOMS7T_KRITERIUM_A_TEXT = paste0(
|
||||
"Bei Personen, die im SOMS-7T mindestens 3 Items als »mittel ausgeprägt« ",
|
||||
"bewertet bzw. einen Prozentrang > 75 haben, besteht ein hohes Risiko auf ein ",
|
||||
"vorliegendes Somatisierungssyndrom."
|
||||
)
|
||||
|
||||
SOMS7T_KRITERIUM_B_HINWEIS = paste0(
|
||||
"Das Manual benennt hierzu einen Prozentrang > 75, ohne eindeutig zu spezifizieren, ",
|
||||
"auf welchen der beiden Kennwerte sich dieser bezieht - beide werden daher zur ",
|
||||
"Einordnung angezeigt."
|
||||
)
|
||||
|
||||
# DSM-IV-33-Item-Liste (gleiche Itemliste wie in der SOMS-2-Schwester-App).
|
||||
SOMS7T_DSMIV_ITEMS = 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)
|
||||
|
||||
SOMS7T_STUFEN_TEXTE = c("gar nicht", "leicht", "mittelmäßig", "stark", "sehr stark")
|
||||
|
||||
library(shiny)
|
||||
library(dplyr)
|
||||
library(ggplot2)
|
||||
library(haven)
|
||||
library(officer)
|
||||
|
||||
|
||||
# Infrastruktur ####
|
||||
|
||||
APP_VERZEICHNIS = normalizePath(getwd())
|
||||
|
||||
absPath = function(pfad) {
|
||||
if (grepl("^([A-Za-z]:[/\\\\]|/)", pfad)) return(pfad)
|
||||
file.path(APP_VERZEICHNIS, pfad)
|
||||
}
|
||||
|
||||
PFAD_DOWNLOAD_SKRIPT = normalizePath(absPath(PFAD_DOWNLOAD_SKRIPT), mustWork = FALSE)
|
||||
PFAD_PSEUDONYM_SKRIPT = normalizePath(absPath(PFAD_PSEUDONYM_SKRIPT), mustWork = FALSE)
|
||||
PFAD_NORM_B1 = normalizePath(absPath(PFAD_NORM_B1), mustWork = FALSE)
|
||||
PFAD_NORM_B2 = normalizePath(absPath(PFAD_NORM_B2), mustWork = FALSE)
|
||||
PFAD_NORM_B3 = normalizePath(absPath(PFAD_NORM_B3), mustWork = FALSE)
|
||||
PFAD_NORM_B4 = normalizePath(absPath(PFAD_NORM_B4), mustWork = FALSE)
|
||||
PFAD_NORM_B5 = normalizePath(absPath(PFAD_NORM_B5), mustWork = FALSE)
|
||||
|
||||
|
||||
# Helper ####
|
||||
|
||||
# In formr-Exporten stehen Markdown-Sternchen im Itemwortlaut und in Choice-Texten.
|
||||
strip_stars = function(x) {
|
||||
if (is.null(x) || length(x) == 0) return(x)
|
||||
gsub("\\*\\*", "", as.character(x))
|
||||
}
|
||||
|
||||
# Label-Text einer der fuenf bekannten Kategorien zuordnen. Laengste Kategorienamen
|
||||
# zuerst pruefen, da "stark" sonst als Teilstring von "sehr stark" faelschlich zuerst
|
||||
# matchen wuerde.
|
||||
soms7t_kategorie_index = function(label_text) {
|
||||
if (is.null(label_text) || length(label_text) == 0 || is.na(label_text[1]))
|
||||
return(NA_integer_)
|
||||
txt = tolower(trimws(strip_stars(label_text[1])))
|
||||
reihenfolge = order(nchar(SOMS7T_STUFEN_TEXTE), decreasing = TRUE)
|
||||
for (idx in reihenfolge) {
|
||||
if (grepl(SOMS7T_STUFEN_TEXTE[idx], txt, fixed = TRUE)) return(idx - 1L)
|
||||
}
|
||||
NA_integer_
|
||||
}
|
||||
|
||||
# Stufe (0-4) immer aus dem labels-Attribut der ORIGINAL-Spalte ableiten, nie aus dem
|
||||
# formr-Rohwert 1-5 direkt, da die Kodierung je nach Setup variieren kann. Stufe = Position
|
||||
# der zugeordneten Kategorie in der festen Reihenfolge "gar nicht".."sehr stark", nicht
|
||||
# die numerische Position des Rohwerts (robust gegenueber abweichender formr-Kodierung).
|
||||
soms7t_get_level = function(original_col, wert) {
|
||||
if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) return(0L)
|
||||
|
||||
lbl = attr(original_col, "labels")
|
||||
if (is.null(lbl) || length(lbl) == 0) {
|
||||
# Fallback ohne labels-Attribut: 1-basierte Kodierung annehmen.
|
||||
return(max(0L, min(4L, as.integer(round(as.numeric(wert[1]))) - 1L)))
|
||||
}
|
||||
|
||||
wert_num = as.numeric(wert[1])
|
||||
pos = which(as.vector(lbl) == wert_num)
|
||||
if (length(pos) == 0) return(0L)
|
||||
|
||||
kat = soms7t_kategorie_index(names(lbl)[pos[1]])
|
||||
if (is.na(kat)) return(0L)
|
||||
kat
|
||||
}
|
||||
|
||||
# label-Attribut der Spalte (Fragetext) lesen und bereinigen. Entfernt neben den
|
||||
# Markdown-Sternchen auch formr-Nummerierungsartefakte am Anfang (z.B. "11\. " oder
|
||||
# "11. "), die aus dem escapeten Markdown-Listenpunkt im Label-Text stammen.
|
||||
soms7t_item_text = function(original_col) {
|
||||
txt = attr(original_col, "label")
|
||||
if (is.null(txt) || length(txt) == 0 || is.na(txt[1])) return(NA_character_)
|
||||
txt = strip_stars(txt[1])
|
||||
txt = sub("^\\s*\\d+\\\\?[.)]\\s*", "", txt)
|
||||
trimws(txt)
|
||||
}
|
||||
|
||||
# Label-Text (z.B. Geschlecht) aus dem labels-Attribut lesen - nie hartkodiert 1/2.
|
||||
soms7t_get_label_text = function(original_col, wert) {
|
||||
if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) return(NA_character_)
|
||||
lbl = attr(original_col, "labels")
|
||||
if (!is.null(lbl) && length(lbl) > 0) {
|
||||
pos = which(as.vector(lbl) == as.numeric(wert[1]))
|
||||
if (length(pos) > 0) return(trimws(strip_stars(names(lbl)[pos[1]])))
|
||||
}
|
||||
NA_character_
|
||||
}
|
||||
|
||||
soms7t_geschlecht_spalte = function(geschlecht_text) {
|
||||
if (is.na(geschlecht_text)) return("gesamt")
|
||||
if (grepl("weiblich", geschlecht_text, ignore.case = TRUE)) return("frauen")
|
||||
if (grepl("männlich", geschlecht_text, ignore.case = TRUE)) return("maenner")
|
||||
"gesamt"
|
||||
}
|
||||
|
||||
# B-2/B-4: Normtabellen mit rohwert_min/rohwert_max-Bereichen (mehrere Rohwerte pro Zeile
|
||||
# moeglich). Rohwert oberhalb des hoechsten Tabelleneintrags -> PR 100.
|
||||
pr_lookup_range = function(tabelle, rohwert, spalte,
|
||||
min_col = "rohwert_min", max_col = "rohwert_max") {
|
||||
if (is.na(rohwert)) return(NA_real_)
|
||||
if (rohwert > max(tabelle[[max_col]], na.rm = TRUE)) return(100)
|
||||
zeile = tabelle[tabelle[[min_col]] <= rohwert & tabelle[[max_col]] >= rohwert, ]
|
||||
if (nrow(zeile) == 0) return(NA_real_)
|
||||
as.numeric(zeile[[spalte]][1])
|
||||
}
|
||||
|
||||
# B-1/B-3: Normtabellen mit exaktem rohwert pro Zeile.
|
||||
pr_lookup_exact = function(tabelle, rohwert, spalte, rohwert_col = "rohwert") {
|
||||
if (is.na(rohwert)) return(NA_real_)
|
||||
if (rohwert > max(tabelle[[rohwert_col]], na.rm = TRUE)) return(100)
|
||||
zeile = tabelle[tabelle[[rohwert_col]] == rohwert, ]
|
||||
if (nrow(zeile) == 0) return(NA_real_)
|
||||
as.numeric(zeile[[spalte]][1])
|
||||
}
|
||||
|
||||
# B-5: PR der Beschwerdenanzahl nach Symptomstaerke-Schwelle. Leere Zellen bedeuten
|
||||
# "bei dieser Schwelle nicht erreichbar" -> NA, kein erzwungener Wert.
|
||||
pr_lookup_b5 = function(tabelle, beschwerdenanzahl, spalte = "staerke_2_4") {
|
||||
if (is.na(beschwerdenanzahl)) return(NA_real_)
|
||||
if (beschwerdenanzahl > max(tabelle[["beschwerdenanzahl"]], na.rm = TRUE)) return(100)
|
||||
zeile = tabelle[tabelle[["beschwerdenanzahl"]] == beschwerdenanzahl, ]
|
||||
if (nrow(zeile) == 0) return(NA_real_)
|
||||
wert = suppressWarnings(as.numeric(zeile[[spalte]][1]))
|
||||
if (is.na(wert)) return(NA_real_)
|
||||
wert
|
||||
}
|
||||
|
||||
# Dichotomisierung: Stufe 0-1 -> 0 Punkte, Stufe 2-4 -> 1 Punkt.
|
||||
soms7t_berechne_beschwerdenanzahl = function(stufen_vektor) {
|
||||
sum(stufen_vektor >= 2, na.rm = TRUE)
|
||||
}
|
||||
|
||||
# Keine Dichotomisierung: Rohsumme der Stufenwerte (0-4).
|
||||
soms7t_berechne_intensitaet = function(stufen_vektor) {
|
||||
sum(stufen_vektor, na.rm = TRUE)
|
||||
}
|
||||
|
||||
soms7t_kriterium_a = function(beschwerdenanzahl) {
|
||||
isTRUE(beschwerdenanzahl >= 3)
|
||||
}
|
||||
|
||||
soms7t_format_pr = function(pr) {
|
||||
if (is.null(pr) || length(pr) == 0 || is.na(pr)) return("—")
|
||||
paste0("PR ", format(round(pr, 1), nsmall = 1))
|
||||
}
|
||||
|
||||
# Vier Stufen-Badge-Klassen (gruen -> dunkelrot), 1:1 aus der BDI-II-App uebernommen.
|
||||
# Rohwert wird per min(stufe, 3L) gedeckelt - Stufe 3 "stark" und Stufe 4 "sehr stark"
|
||||
# teilen sich damit die dunkelste Badge-Farbe (nur 4 Klassen vorgesehen, siehe Abschnitt 5).
|
||||
soms7t_badge_klasse = function(stufe) {
|
||||
paste0("stufe-badge-", min(max(stufe, 0L), 3L))
|
||||
}
|
||||
|
||||
SOMS7T_BADGE_WORD_FARBEN = list(
|
||||
"0" = list(bg = "#C8E6C9", text = "#1B5E20"),
|
||||
"1" = list(bg = "#FFCDD2", text = "#B71C1C"),
|
||||
"2" = list(bg = "#EF9A9A", text = "#7B0000"),
|
||||
"3" = list(bg = "#B71C1C", text = "#FFFFFF")
|
||||
)
|
||||
|
||||
|
||||
# Datenaufbereitung ####
|
||||
|
||||
.soms7t_norm_pfade = c(
|
||||
"B-1 (Patientennorm)" = PFAD_NORM_B1,
|
||||
"B-2 (Beschwerdenanzahl, Gesunde)" = PFAD_NORM_B2,
|
||||
"B-3 (DSM-IV, Gesunde)" = PFAD_NORM_B3,
|
||||
"B-4 (Intensitaetsindex, Gesunde)" = PFAD_NORM_B4,
|
||||
"B-5 (nach Symptomstaerke, Gesunde)" = PFAD_NORM_B5
|
||||
)
|
||||
|
||||
.soms7t_fehlende_normen = names(.soms7t_norm_pfade)[!file.exists(.soms7t_norm_pfade)]
|
||||
|
||||
if (length(.soms7t_fehlende_normen) > 0) {
|
||||
stop(
|
||||
"SOMS-7T: Folgende Normtabellen-CSVs fehlen im Ordner 'normen/':\n",
|
||||
paste0(" - ", .soms7t_fehlende_normen, ": ",
|
||||
.soms7t_norm_pfade[.soms7t_fehlende_normen], collapse = "\n"),
|
||||
"\nBitte die fehlenden Dateien ablegen und die App neu starten."
|
||||
)
|
||||
}
|
||||
|
||||
norm_b1 = read.csv(PFAD_NORM_B1, stringsAsFactors = FALSE)
|
||||
norm_b2 = read.csv(PFAD_NORM_B2, stringsAsFactors = FALSE)
|
||||
norm_b3 = read.csv(PFAD_NORM_B3, stringsAsFactors = FALSE)
|
||||
norm_b4 = read.csv(PFAD_NORM_B4, stringsAsFactors = FALSE)
|
||||
norm_b5 = read.csv(PFAD_NORM_B5, stringsAsFactors = FALSE)
|
||||
|
||||
|
||||
# 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; }
|
||||
.kennwert-block {
|
||||
display: flex; gap: 28px; flex-wrap: wrap; align-items: flex-start;
|
||||
padding: 10px 0;
|
||||
}
|
||||
.kennwert-zahl { font-size: 2.0rem; font-weight: 800; color: #8B2635; }
|
||||
.kennwert-label { color: #555; font-size: 0.88em; margin-top: 2px; }
|
||||
.kennwert-pr { font-size: 0.95em; color: #333; margin-top: 4px; }
|
||||
.kennwert-pr-patient { font-size: 0.85em; color: #777; margin-top: 2px; font-style: italic; }
|
||||
.kriterium-box {
|
||||
border-radius: 6px; padding: 14px 18px; margin: 10px 0;
|
||||
border-left: 5px solid;
|
||||
}
|
||||
.kriterium-erfuellt { background: #FFEBEE; border-color: #EF9A9A; color: #B71C1C; }
|
||||
.kriterium-nicht { background: #F5F5F5; border-color: #9E9E9E; color: #424242; }
|
||||
.kriterium-titel { font-weight: 700; font-size: 1.0rem; margin-bottom: 6px; }
|
||||
.kriterium-text { font-size: 0.92em; line-height: 1.5; }
|
||||
.kriterium-b-werte {
|
||||
display: flex; gap: 24px; margin-top: 8px; flex-wrap: wrap; font-size: 0.92em;
|
||||
}
|
||||
.kriterium-b-hinweis {
|
||||
font-size: 0.82em; color: #777; font-style: italic; margin-top: 8px;
|
||||
}
|
||||
.item-zeile {
|
||||
display: flex; align-items: flex-start; gap: 10px;
|
||||
padding: 7px 0; border-bottom: 1px solid #F0F0F0;
|
||||
}
|
||||
.item-nr { font-weight: 600; color: #8B2635; min-width: 26px; flex-shrink: 0; }
|
||||
.item-text { flex: 1; color: #333; font-size: 0.92em; }
|
||||
.stufe-badge {
|
||||
border-radius: 4px; padding: 2px 9px; font-weight: 700;
|
||||
font-size: 0.82em; white-space: nowrap; display: inline-block; flex-shrink: 0;
|
||||
}
|
||||
.stufe-badge-0 { background-color: #C8E6C9; color: #1B5E20; }
|
||||
.stufe-badge-1 { background-color: #FFCDD2; color: #B71C1C; }
|
||||
.stufe-badge-2 { background-color: #EF9A9A; color: #7B0000; }
|
||||
.stufe-badge-3 { background-color: #B71C1C; color: white; }
|
||||
.disclaimer-zeile {
|
||||
font-size: 0.82em; color: #777; font-style: italic;
|
||||
margin-top: 10px; border-top: 1px solid rgba(0,0,0,.1); padding-top: 8px;
|
||||
}
|
||||
"
|
||||
|
||||
app_css = gsub("#8B2635", AKZENT_FARBE, app_css, fixed = TRUE)
|
||||
|
||||
ui = fluidPage(
|
||||
tags$head(
|
||||
tags$meta(charset = "UTF-8"),
|
||||
tags$style(HTML(app_css))
|
||||
),
|
||||
|
||||
div(class = "app-header",
|
||||
tags$h2("SOMS-7T – Screening für somatoforme Störungen (7-Tage-Version)"),
|
||||
tags$p("Beschwerdenanzahl & Intensitätsindex mit Normvergleich")
|
||||
),
|
||||
|
||||
div(class = "container-fluid",
|
||||
|
||||
div(class = "input-panel",
|
||||
div(style = "min-width: 360px; white-space: nowrap;",
|
||||
textInput("pseudonym",
|
||||
label = tagList(
|
||||
"Pseudonym",
|
||||
tags$span(style = "font-weight: normal; font-style: italic; font-size: 0.78em; color: #888; margin-left: 4px; white-space: nowrap;",
|
||||
"optional, hat Vorrang vor Chiffre")
|
||||
),
|
||||
placeholder = "optional", width = "340px")
|
||||
),
|
||||
div(style = "min-width: 200px;",
|
||||
textInput("chiffre", label = "Patientenchiffre",
|
||||
placeholder = "z.B. P000123", width = "100%")
|
||||
),
|
||||
actionButton("btn_suchen", "Auswerten", class = "btn btn-primary btn-laden"),
|
||||
div(style = "margin-left: auto;",
|
||||
downloadButton("download_word", "Word-Export (.docx)")
|
||||
)
|
||||
),
|
||||
|
||||
uiOutput("fehler_ui"),
|
||||
uiOutput("warnung_ui"),
|
||||
uiOutput("ergebnis_ui")
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
# Word-Export ####
|
||||
|
||||
erstelle_soms7t_docx = function(erg) {
|
||||
doc = read_docx()
|
||||
|
||||
fp_titel = fp_text(color = AKZENT_FARBE, bold = TRUE, font.size = 18)
|
||||
fp_abschnitt = fp_text(color = AKZENT_FARBE, bold = TRUE, font.size = 13)
|
||||
fp_label = fp_text(bold = TRUE, font.size = 11)
|
||||
fp_normal = fp_text(font.size = 11)
|
||||
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("SOMS-7T — Auswertung", fp_titel)))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Chiffre: ", fp_label),
|
||||
ftext(erg$chiffre, fp_normal),
|
||||
ftext(" Datum: ", 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$info_mehrere)) {
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(erg$info_mehrere, fp_text(font.size = 10, italic = TRUE, color = "#555555"))
|
||||
))
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Beschwerdenanzahl", fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Rohwert (alle 53 Items, Stufe ≥2): ", fp_label),
|
||||
ftext(paste0(erg$beschwerden_gesamt, " ",
|
||||
soms7t_format_pr(erg$pr_beschwerden_gesund),
|
||||
" (Gesunden-Norm, geschlechtsgetrennt)"), fp_normal)
|
||||
))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Vergleichswert: psychosomatische Patienten (Veraenderungsmessung): ",
|
||||
fp_text(font.size = 10, italic = TRUE, color = "#555555")),
|
||||
ftext(soms7t_format_pr(erg$pr_beschwerden_patient),
|
||||
fp_text(font.size = 10, italic = TRUE, color = "#555555"))
|
||||
))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Rohwert DSM-IV-Liste (33 Items, Stufe ≥2): ", fp_label),
|
||||
ftext(paste0(erg$beschwerden_dsmiv, " ", soms7t_format_pr(erg$pr_dsmiv)), fp_normal)
|
||||
))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Intensitätsindex", fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Rohwert (Summe aller 53 Item-Stufen, 0-212): ", fp_label),
|
||||
ftext(paste0(erg$intensitaet, " ",
|
||||
soms7t_format_pr(erg$pr_intensitaet_gesund),
|
||||
" (Gesunden-Norm, geschlechtsgetrennt)"), fp_normal)
|
||||
))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Vergleichswert: psychosomatische Patienten (Veraenderungsmessung): ",
|
||||
fp_text(font.size = 10, italic = TRUE, color = "#555555")),
|
||||
ftext(soms7t_format_pr(erg$pr_intensitaet_patient),
|
||||
fp_text(font.size = 10, italic = TRUE, color = "#555555"))
|
||||
))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Screening-Kriterium", fp_abschnitt)))
|
||||
if (erg$kriterium_a) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
paste0("Screening-Kriterium A erfuellt (≥3 Items mittelmaessig+): ",
|
||||
erg$beschwerden_gesamt, " Items."),
|
||||
fp_text(bold = TRUE, font.size = 11, color = "#B71C1C")
|
||||
)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(SOMS7T_KRITERIUM_A_TEXT,
|
||||
fp_text(font.size = 10, color = "#B71C1C"))))
|
||||
} else {
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
paste0("Screening-Kriterium A nicht erfuellt (", erg$beschwerden_gesamt,
|
||||
" von 3 Items mittelmaessig+)."),
|
||||
fp_text(bold = TRUE, font.size = 11, color = "#424242")
|
||||
)))
|
||||
}
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Kriterium B (Zusatzinformation) - PR Beschwerdenanzahl (Schwelle 2-4): ",
|
||||
fp_label),
|
||||
ftext(soms7t_format_pr(erg$pr_staerke_2_4), fp_normal),
|
||||
ftext(" PR Intensitätsindex: ", fp_label),
|
||||
ftext(soms7t_format_pr(erg$pr_intensitaet_gesund), fp_normal)
|
||||
))
|
||||
doc = body_add_fpar(doc, fpar(ftext(SOMS7T_KRITERIUM_B_HINWEIS,
|
||||
fp_text(font.size = 9, italic = TRUE, color = "#777777"))))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Items mit Stufe ≥ mittelmäßig", fp_abschnitt)))
|
||||
if (nrow(erg$items_liste) == 0) {
|
||||
doc = body_add_fpar(doc, fpar(ftext("Keine Items mit Stufe ≥2 vorhanden.", fp_normal)))
|
||||
} else {
|
||||
for (r in seq_len(nrow(erg$items_liste))) {
|
||||
zeile = erg$items_liste[r, ]
|
||||
badge_key = as.character(min(max(zeile$stufe, 0L), 3L))
|
||||
farben = SOMS7T_BADGE_WORD_FARBEN[[badge_key]]
|
||||
fp_badge = fp_text(color = farben$text, bold = TRUE,
|
||||
shading.color = farben$bg, font.size = 10)
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(zeile$nummer, ". ", zeile$text, " "), fp_normal),
|
||||
ftext(paste0(" ", SOMS7T_STUFEN_TEXTE[zeile$stufe + 1L], " "), fp_badge)
|
||||
))
|
||||
}
|
||||
}
|
||||
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
doc = body_add_fpar(doc, fpar(ftext(SOMS7T_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(error = "Bitte eine Patientenchiffre eingeben."))
|
||||
|
||||
if (!(nchar(trimws(input$pseudonym)) > 0 || grepl("^[A-Z][0-9]{6}$", chiffre)))
|
||||
return(list(error = paste0(
|
||||
"Ungültige Chiffre. Erwartet: ein Großbuchstabe + 6 Ziffern (z.B. P000123).")))
|
||||
|
||||
if (!file.exists(PFAD_DOWNLOAD_SKRIPT))
|
||||
return(list(error = paste0(
|
||||
"Download-Skript nicht gefunden:\n", PFAD_DOWNLOAD_SKRIPT)))
|
||||
if (!file.exists(PFAD_PSEUDONYM_SKRIPT))
|
||||
return(list(error = paste0(
|
||||
"Pseudonym-Skript nicht gefunden:\n", PFAD_PSEUDONYM_SKRIPT)))
|
||||
|
||||
res_dl = tryCatch(
|
||||
{ source(PFAD_DOWNLOAD_SKRIPT, local = FALSE); list(ok = TRUE) },
|
||||
error = function(e) list(ok = FALSE, msg = e$message)
|
||||
)
|
||||
if (!res_dl$ok)
|
||||
return(list(error = paste0("Fehler im Download-Skript: ", res_dl$msg)))
|
||||
|
||||
db_ordner = local({
|
||||
ordner = dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE))
|
||||
gefunden = NULL
|
||||
for (i in 1:5) {
|
||||
if (file.exists(file.path(ordner, "pseudonyme.db"))) {
|
||||
gefunden = ordner
|
||||
break
|
||||
}
|
||||
elternteil = dirname(ordner)
|
||||
if (elternteil == ordner) break
|
||||
ordner = elternteil
|
||||
}
|
||||
gefunden
|
||||
})
|
||||
|
||||
alter_wd = getwd()
|
||||
wd_ziel = if (!is.null(db_ordner)) db_ordner else
|
||||
dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE))
|
||||
setwd(wd_ziel)
|
||||
on.exit(setwd(alter_wd), add = TRUE)
|
||||
|
||||
res_ps = tryCatch(
|
||||
{ source(PFAD_PSEUDONYM_SKRIPT, local = FALSE)
|
||||
if (nchar(trimws(input$pseudonym)) > 0) {
|
||||
.pw_wert = trimws(input$pseudonym)
|
||||
.pw_tab = get("pseudo", envir = .GlobalEnv)
|
||||
.pw_treffer = .pw_tab[.pw_tab$pseudonym == .pw_wert, ]
|
||||
if (nrow(.pw_treffer) > 0) chiffre = toupper(trimws(.pw_treffer$chiffre[1]))
|
||||
}; list(ok = TRUE) },
|
||||
error = function(e) list(ok = FALSE, msg = e$message)
|
||||
)
|
||||
if (!res_ps$ok)
|
||||
return(list(error = paste0("Fehler im Pseudonym-Skript: ", res_ps$msg)))
|
||||
|
||||
if (!exists("daten_soms7t", envir = .GlobalEnv))
|
||||
return(list(error = paste0(
|
||||
"Objekt 'daten_soms7t' nach dem Sourcen nicht gefunden. ",
|
||||
"Bitte Download-Skript prüfen.")))
|
||||
if (!exists("pseudo", envir = .GlobalEnv))
|
||||
return(list(error = paste0(
|
||||
"Objekt 'pseudo' nach dem Sourcen nicht gefunden. ",
|
||||
"Bitte Pseudonym-Skript prüfen.")))
|
||||
|
||||
daten = get("daten_soms7t", envir = .GlobalEnv)
|
||||
pseudo_df = get("pseudo", envir = .GlobalEnv)
|
||||
|
||||
treffer_ps = pseudo_df[pseudo_df$chiffre == chiffre, ]
|
||||
if (nrow(treffer_ps) == 0)
|
||||
return(list(error = paste0(
|
||||
"Chiffre '", chiffre, "' wurde in der Pseudonym-Datenbank nicht gefunden.")))
|
||||
|
||||
alle_session_ids = unique(treffer_ps$pseudonym)
|
||||
if (nchar(trimws(input$pseudonym)) > 0) alle_session_ids = trimws(input$pseudonym)
|
||||
|
||||
treffer_dat = daten[daten$session %in% alle_session_ids, ]
|
||||
if (nrow(treffer_dat) == 0)
|
||||
return(list(error = paste0(
|
||||
"Kein SOMS-7T-Datensatz für Chiffre '", chiffre, "' gefunden. ",
|
||||
"(", length(alle_session_ids), " Pseudonym(e) geprüft)")))
|
||||
|
||||
info_mehrere = NULL
|
||||
if (nrow(treffer_dat) > 1) {
|
||||
n = nrow(treffer_dat)
|
||||
treffer_dat = treffer_dat[order(treffer_dat$created, decreasing = TRUE), ]
|
||||
datum_neu = tryCatch(
|
||||
format(as.POSIXct(treffer_dat$created[1]), "%d.%m.%Y %H:%M"),
|
||||
error = function(e) "unbekanntes Datum"
|
||||
)
|
||||
info_mehrere = paste0(
|
||||
"Mehrere Ausfüllungen gefunden (", n, " Einträge). ",
|
||||
"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 = soms7t_get_label_text(daten[["soms7t_geschlecht"]],
|
||||
zeile[["soms7t_geschlecht"]])
|
||||
geschlecht_spalte = soms7t_geschlecht_spalte(geschlecht_text)
|
||||
|
||||
stufen = integer(53)
|
||||
item_texte = character(53)
|
||||
for (i in seq_len(53)) {
|
||||
var = paste0("soms7t_", sprintf("%02d", i))
|
||||
stufen[i] = soms7t_get_level(daten[[var]], zeile[[var]])
|
||||
item_texte[i] = soms7t_item_text(daten[[var]])
|
||||
if (is.na(item_texte[i])) item_texte[i] = paste0("Item ", i)
|
||||
}
|
||||
|
||||
beschwerden_gesamt = soms7t_berechne_beschwerdenanzahl(stufen)
|
||||
beschwerden_dsmiv = soms7t_berechne_beschwerdenanzahl(stufen[SOMS7T_DSMIV_ITEMS])
|
||||
intensitaet = soms7t_berechne_intensitaet(stufen)
|
||||
|
||||
pr_beschwerden_gesund = pr_lookup_range(norm_b2, beschwerden_gesamt, geschlecht_spalte)
|
||||
pr_beschwerden_patient = pr_lookup_exact(norm_b1, beschwerden_gesamt, "pr_beschwerdenanzahl")
|
||||
pr_dsmiv = pr_lookup_exact(norm_b3, beschwerden_dsmiv, geschlecht_spalte)
|
||||
pr_intensitaet_gesund = pr_lookup_range(norm_b4, intensitaet, geschlecht_spalte)
|
||||
pr_intensitaet_patient = pr_lookup_exact(norm_b1, intensitaet, "pr_intensitaetsindex")
|
||||
pr_staerke_2_4 = pr_lookup_b5(norm_b5, beschwerden_gesamt, "staerke_2_4")
|
||||
|
||||
kriterium_a = soms7t_kriterium_a(beschwerden_gesamt)
|
||||
|
||||
items_idx = which(stufen >= 2)
|
||||
items_liste = data.frame(
|
||||
nummer = items_idx,
|
||||
text = item_texte[items_idx],
|
||||
stufe = stufen[items_idx],
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
list(
|
||||
chiffre = chiffre,
|
||||
datum_str = datum_str,
|
||||
info_mehrere = info_mehrere,
|
||||
geschlecht_text = geschlecht_text,
|
||||
beschwerden_gesamt = beschwerden_gesamt,
|
||||
beschwerden_dsmiv = beschwerden_dsmiv,
|
||||
intensitaet = intensitaet,
|
||||
pr_beschwerden_gesund = pr_beschwerden_gesund,
|
||||
pr_beschwerden_patient = pr_beschwerden_patient,
|
||||
pr_dsmiv = pr_dsmiv,
|
||||
pr_intensitaet_gesund = pr_intensitaet_gesund,
|
||||
pr_intensitaet_patient = pr_intensitaet_patient,
|
||||
pr_staerke_2_4 = pr_staerke_2_4,
|
||||
kriterium_a = kriterium_a,
|
||||
items_liste = items_liste,
|
||||
error = NULL
|
||||
)
|
||||
})
|
||||
|
||||
output$fehler_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (!is.null(d$error)) div(class = "alert-fehler", d$error)
|
||||
})
|
||||
|
||||
output$warnung_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (!is.null(d$error) || is.null(d$info_mehrere)) return(NULL)
|
||||
div(class = "alert-warnung", d$info_mehrere)
|
||||
})
|
||||
|
||||
output$ergebnis_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (!is.null(d$error)) return(NULL)
|
||||
|
||||
items_ui = if (nrow(d$items_liste) == 0) {
|
||||
div(style = "color:#777; font-style:italic;", "Keine Items mit Stufe ≥2 vorhanden.")
|
||||
} else {
|
||||
lapply(seq_len(nrow(d$items_liste)), function(r) {
|
||||
zeile = d$items_liste[r, ]
|
||||
div(class = "item-zeile",
|
||||
div(class = "item-nr", paste0(zeile$nummer, ".")),
|
||||
div(class = "item-text", zeile$text),
|
||||
span(class = paste0("stufe-badge ", soms7t_badge_klasse(zeile$stufe)),
|
||||
SOMS7T_STUFEN_TEXTE[zeile$stufe + 1L])
|
||||
)
|
||||
})
|
||||
}
|
||||
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "SOMS-7T – Auswertung"),
|
||||
|
||||
div(class = "meta-block",
|
||||
tags$strong("Chiffre: "), d$chiffre,
|
||||
tags$span(" | ", style = "color:#ccc;"),
|
||||
tags$strong("Ausfülldatum: "), d$datum_str,
|
||||
tags$span(" | ", style = "color:#ccc;"),
|
||||
tags$strong("Geschlecht: "), if (is.na(d$geschlecht_text)) "k. A." else d$geschlecht_text
|
||||
),
|
||||
|
||||
tags$hr(),
|
||||
|
||||
tags$h5("Beschwerdenanzahl"),
|
||||
div(class = "kennwert-block",
|
||||
div(
|
||||
div(class = "kennwert-zahl", d$beschwerden_gesamt),
|
||||
div(class = "kennwert-label", "Rohwert (alle 53 Items, Stufe ≥2)"),
|
||||
div(class = "kennwert-pr", soms7t_format_pr(d$pr_beschwerden_gesund),
|
||||
" (Gesunden-Norm, geschlechtsgetrennt)"),
|
||||
div(class = "kennwert-pr-patient",
|
||||
"Vergleichswert: psychosomatische Patienten (Veränderungsmessung): ",
|
||||
soms7t_format_pr(d$pr_beschwerden_patient))
|
||||
),
|
||||
div(
|
||||
div(class = "kennwert-zahl", d$beschwerden_dsmiv),
|
||||
div(class = "kennwert-label", "Rohwert DSM-IV-Liste (33 Items, Stufe ≥2)"),
|
||||
div(class = "kennwert-pr", soms7t_format_pr(d$pr_dsmiv))
|
||||
)
|
||||
),
|
||||
|
||||
tags$hr(),
|
||||
|
||||
tags$h5("Intensitätsindex"),
|
||||
div(class = "kennwert-block",
|
||||
div(
|
||||
div(class = "kennwert-zahl", d$intensitaet),
|
||||
div(class = "kennwert-label", "Rohwert (Summe aller 53 Item-Stufen, 0-212)"),
|
||||
div(class = "kennwert-pr", soms7t_format_pr(d$pr_intensitaet_gesund),
|
||||
" (Gesunden-Norm, geschlechtsgetrennt)"),
|
||||
div(class = "kennwert-pr-patient",
|
||||
"Vergleichswert: psychosomatische Patienten (Veränderungsmessung): ",
|
||||
soms7t_format_pr(d$pr_intensitaet_patient))
|
||||
)
|
||||
),
|
||||
|
||||
tags$hr(),
|
||||
|
||||
tags$h5("Screening-Kriterium"),
|
||||
div(class = paste0("kriterium-box ", if (d$kriterium_a) "kriterium-erfuellt" else "kriterium-nicht"),
|
||||
div(class = "kriterium-titel",
|
||||
if (d$kriterium_a)
|
||||
paste0("Screening-Kriterium A erfüllt (≥3 Items mittelmäßig+): ",
|
||||
d$beschwerden_gesamt, " Items")
|
||||
else
|
||||
paste0("Screening-Kriterium A nicht erfüllt (", d$beschwerden_gesamt,
|
||||
" von 3 Items mittelmäßig+)")
|
||||
),
|
||||
if (d$kriterium_a) div(class = "kriterium-text", SOMS7T_KRITERIUM_A_TEXT),
|
||||
div(class = "kriterium-b-werte",
|
||||
div(tags$strong("Kriterium B – PR Beschwerdenanzahl (Schwelle 2-4): "),
|
||||
soms7t_format_pr(d$pr_staerke_2_4)),
|
||||
div(tags$strong("PR Intensitätsindex: "), soms7t_format_pr(d$pr_intensitaet_gesund))
|
||||
),
|
||||
div(class = "kriterium-b-hinweis", SOMS7T_KRITERIUM_B_HINWEIS)
|
||||
),
|
||||
|
||||
tags$hr(),
|
||||
|
||||
tags$h5("Items mit Stufe ≥ mittelmäßig"),
|
||||
div(items_ui),
|
||||
|
||||
div(class = "disclaimer-zeile", SOMS7T_DISCLAIMER)
|
||||
)
|
||||
})
|
||||
|
||||
output$download_word = downloadHandler(
|
||||
filename = function() {
|
||||
d = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
chiffre_esc = if (is.list(d) && is.null(d$error) && nchar(d$chiffre) > 0)
|
||||
gsub("[^A-Za-z0-9_-]", "_", d$chiffre) else "export"
|
||||
datum = if (is.list(d) && is.null(d$error) && !is.null(d$datum_str))
|
||||
tryCatch(
|
||||
format(as.Date(d$datum_str, "%d.%m.%Y"), "%Y%m%d"),
|
||||
error = function(e) format(Sys.Date(), "%Y%m%d")
|
||||
)
|
||||
else
|
||||
format(Sys.Date(), "%Y%m%d")
|
||||
paste0("SOMS7T_", chiffre_esc, "_", datum, ".docx")
|
||||
},
|
||||
content = function(file) {
|
||||
d = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
daten_ok = is.list(d) && is.null(d$error)
|
||||
if (!daten_ok) {
|
||||
doc = read_docx()
|
||||
doc = body_add_par(doc,
|
||||
"Kein Datensatz geladen. Bitte zuerst Chiffre eingeben und 'Auswerten' klicken.",
|
||||
style = "Normal")
|
||||
print(doc, target = file)
|
||||
return()
|
||||
}
|
||||
doc = tryCatch(
|
||||
erstelle_soms7t_docx(d),
|
||||
error = function(e) {
|
||||
err_doc = read_docx()
|
||||
body_add_par(err_doc,
|
||||
paste0("Fehler beim Erstellen des Word-Dokuments: ", e$message),
|
||||
style = "Normal")
|
||||
}
|
||||
)
|
||||
print(doc, target = file)
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
# Start ####
|
||||
|
||||
shinyApp(ui, server)
|
||||
Loading…
Add table
Add a link
Reference in a new issue