Initial commit
This commit is contained in:
commit
3cba772836
1341 changed files with 532924 additions and 0 deletions
814
ESI/app.R
Normal file
814
ESI/app.R
Normal file
|
|
@ -0,0 +1,814 @@
|
|||
# Präambel ####
|
||||
|
||||
AKZENT_FARBE = "#8B2635"
|
||||
|
||||
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_esi.R"
|
||||
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"
|
||||
|
||||
ESI_VALIDITAETS_ZITAT = paste0(
|
||||
"Die Ergebnisse der Skalen AS, AU, IR und DP sind fragwuerdig, wenn in der ",
|
||||
"Kontrollskala FR weniger als zwei Punkte erzielt wurden oder wenn in ",
|
||||
"Kontrollfrage 40 „stimmt gar nicht“ angekreuzt wurde."
|
||||
)
|
||||
|
||||
ESI_GESAMT_DISCLAIMER = paste0(
|
||||
"Das Ueberschreiten dieser Grenzwerte begruendet allein nicht die Diagnose ",
|
||||
"einer Schizophrenie, sondern soll Anlass fuer weitere diagnostische ",
|
||||
"Massnahmen geben."
|
||||
)
|
||||
|
||||
ESI_NORM_HINWEIS = paste0(
|
||||
"Es liegen keine vollstaendigen Rohscore-zu-z/T/Stanine-Normtabellen vor. ",
|
||||
"Es kann nur ein deskriptiver Mittelwert-/SD-Vergleich erfolgen, keine ",
|
||||
"echte Perzentil- oder Stanine-Einordnung."
|
||||
)
|
||||
|
||||
# Rohwert-Badge-Farben 0-3, projektweite Akzentuierung (siehe PG13R_BADGE_FARBEN),
|
||||
# hier auf die 4 ESI-Antwortstufen gekuerzt.
|
||||
ESI_BADGE_FARBEN = c(
|
||||
"0" = "#4CAF50",
|
||||
"1" = "#F48FB1",
|
||||
"2" = "#EF5350",
|
||||
"3" = "#B71C1C"
|
||||
)
|
||||
ESI_BADGE_TEXT_FARBEN = c(
|
||||
"0" = "white",
|
||||
"1" = "#333333",
|
||||
"2" = "white",
|
||||
"3" = "white"
|
||||
)
|
||||
|
||||
library(shiny)
|
||||
library(dplyr)
|
||||
library(ggplot2)
|
||||
library(haven)
|
||||
library(officer)
|
||||
library(DBI)
|
||||
library(RSQLite)
|
||||
|
||||
|
||||
# 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)
|
||||
|
||||
# Kandidaten in Prioritaetsreihenfolge - exakter Spaltenname in daten_esi
|
||||
# war zum Bauzeitpunkt nicht verifizierbar (siehe Projektnotizen).
|
||||
ESI_DATUM_KANDIDATEN = c("ausfuelldatum", "created", "ended", "expired", "modified")
|
||||
ESI_SESSION_KANDIDATEN = c("session", "pseudonym")
|
||||
|
||||
|
||||
# Helper ####
|
||||
|
||||
esi_clean_label = function(text) {
|
||||
if (is.null(text) || length(text) == 0 || is.na(text[1])) return(NA_character_)
|
||||
trimws(gsub("\\*\\*", "", as.character(text[1])))
|
||||
}
|
||||
|
||||
# Itemtext aus dem ORIGINAL label-Attribut. Entfernt formr-Nummerierungsartefakte
|
||||
# am Anfang (z.B. "1. ", "01) " oder mit Markdown-Escape "17\. ") sowie
|
||||
# verbleibende Markdown-Escapes (z.B. "\." -> "."), damit die Nummer nicht
|
||||
# doppelt erscheint (Nummer wird separat ueber esi_item_nummer() angezeigt).
|
||||
esi_item_text = function(daten, var) {
|
||||
txt = esi_clean_label(attr(daten[[var]], "label"))
|
||||
if (is.na(txt)) return(NA_character_)
|
||||
txt = sub("^\\d+\\\\?[.)]\\s*", "", txt)
|
||||
txt = gsub("\\\\([.)(_*+~`>#-])", "\\1", txt)
|
||||
trimws(txt)
|
||||
}
|
||||
|
||||
# Item-Nummer aus dem Variablennamen (z.B. "esi_05_as" -> "5").
|
||||
esi_item_nummer = function(var) {
|
||||
m = regmatches(var, regexpr("\\d+", var))
|
||||
if (length(m) == 0) return(var)
|
||||
as.character(as.integer(m))
|
||||
}
|
||||
|
||||
# Loest den Choice-Index (1 = "stimmt genau" ... 4 = "stimmt gar nicht") ueber
|
||||
# das labels-Attribut der ORIGINAL-Spalte auf - niemals ueber den rohen
|
||||
# numerischen Code, da dessen Kodierung pro Setup variieren kann.
|
||||
esi_choice_index = 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) return(NA_integer_)
|
||||
pos = which(as.vector(lbl_attr) == as.numeric(wert[1]))
|
||||
if (length(pos) == 0) return(NA_integer_)
|
||||
txt = tolower(esi_clean_label(names(lbl_attr)[pos[1]]))
|
||||
if (is.na(txt)) return(NA_integer_)
|
||||
if (grepl("gar nicht", txt)) return(4L)
|
||||
if (grepl("genau", txt)) return(1L)
|
||||
if (grepl("berwiegend", txt)) return(2L)
|
||||
if (grepl("etwas", txt)) return(3L)
|
||||
NA_integer_
|
||||
}
|
||||
|
||||
esi_recode_item = function(daten, zeile, var) {
|
||||
idx = esi_choice_index(daten[[var]], zeile[[var]])
|
||||
if (is.na(idx)) return(NA_real_)
|
||||
4 - idx
|
||||
}
|
||||
|
||||
esi_cutoff_stufe = function(skala, wert) {
|
||||
zeile = ESI_CUTOFF_TABELLE[ESI_CUTOFF_TABELLE$skala == skala, ]
|
||||
if (nrow(zeile) == 0 || is.na(wert)) return(NA_character_)
|
||||
if (wert <= zeile$normal_bis) return("normal")
|
||||
if (wert <= zeile$erhoeht_bis) return("erhoeht")
|
||||
"extrem"
|
||||
}
|
||||
|
||||
esi_cutoff_label = c(normal = "normal", erhoeht = "erhöht", extrem = "extrem")
|
||||
|
||||
esi_gesamt_interpretation = function(score) {
|
||||
if (score >= 40) {
|
||||
list(stufe = "deutlich",
|
||||
text = paste0("Gesamtscore ≥ 40 (", score, "): deutlicher Hinweis auf ",
|
||||
"psychotische Entwicklung."))
|
||||
} else if (score > 30) {
|
||||
list(stufe = "leicht",
|
||||
text = paste0("Gesamtscore > 30 (", score, "): leichter Hinweis auf ",
|
||||
"psychotische Entwicklung."))
|
||||
} else {
|
||||
list(stufe = "unauffaellig",
|
||||
text = paste0("Gesamtscore ≤ 30 (", score, "): unauffaellig im Vergleich ",
|
||||
"zur nicht-schizophrenen Vergleichsgruppe (MIX)."))
|
||||
}
|
||||
}
|
||||
|
||||
# Berechnet Subskalen, Gesamtscore und Validitaetspruefung aus einer Zeile
|
||||
# von daten_esi. `daten` wird fuer den Zugriff auf die ORIGINAL-labels-Attribute
|
||||
# benoetigt (siehe esi_choice_index).
|
||||
esi_berechne = function(daten, zeile) {
|
||||
alle_items = unlist(ESI_SUBSKALEN, use.names = FALSE)
|
||||
rohwerte = setNames(
|
||||
sapply(alle_items, function(v) esi_recode_item(daten, zeile, v)),
|
||||
alle_items
|
||||
)
|
||||
|
||||
subskalen = sapply(names(ESI_SUBSKALEN), function(sk) {
|
||||
sum(rohwerte[ESI_SUBSKALEN[[sk]]], na.rm = TRUE)
|
||||
})
|
||||
|
||||
gesamtscore = sum(subskalen[c("AS", "AU", "IR", "DP")])
|
||||
|
||||
esi40_idx = esi_choice_index(daten[["esi_40"]], zeile[["esi_40"]])
|
||||
esi40_gar_nicht = !is.na(esi40_idx) && esi40_idx == 4L
|
||||
|
||||
fragwuerdig = isTRUE(subskalen[["FR"]] < 2) || esi40_gar_nicht
|
||||
|
||||
list(
|
||||
rohwerte = rohwerte,
|
||||
subskalen = subskalen,
|
||||
gesamtscore = gesamtscore,
|
||||
esi40_gar_nicht = esi40_gar_nicht,
|
||||
fragwuerdig = fragwuerdig
|
||||
)
|
||||
}
|
||||
|
||||
esi_finde_ausfuelldatum = function(zeile) {
|
||||
for (sp in ESI_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({
|
||||
txt = trimws(as.character(wert))
|
||||
if (grepl("^\\d{2}\\.\\d{2}\\.\\d{4}$", txt)) {
|
||||
as.Date(txt, format = "%d.%m.%Y")
|
||||
} else {
|
||||
as.Date(txt)
|
||||
}
|
||||
}, error = function(e) NA)
|
||||
if (!is.na(datum)) return(datum)
|
||||
}
|
||||
}
|
||||
}
|
||||
NA
|
||||
}
|
||||
|
||||
esi_finde_session_spalte = function(daten) {
|
||||
for (sp in ESI_SESSION_KANDIDATEN) if (sp %in% names(daten)) return(sp)
|
||||
NA_character_
|
||||
}
|
||||
|
||||
|
||||
# Datenaufbereitung ####
|
||||
|
||||
ESI_SUBSKALEN = list(
|
||||
AS = c("esi_01_as", "esi_05_as", "esi_10_as", "esi_14_as", "esi_19_as",
|
||||
"esi_24_as", "esi_34_as", "esi_35_as", "esi_38_as", "esi_39_as"),
|
||||
AU = c("esi_02_au", "esi_06_au", "esi_11_au", "esi_15_au", "esi_20_au",
|
||||
"esi_25_au", "esi_29_au", "esi_30_au"),
|
||||
IR = c("esi_04_ir", "esi_08_ir", "esi_17_ir", "esi_22_ir", "esi_27_ir",
|
||||
"esi_32_ir", "esi_37_ir"),
|
||||
DP = c("esi_03_dp", "esi_07_dp", "esi_12_dp", "esi_13_dp", "esi_16_dp",
|
||||
"esi_21_dp", "esi_26_dp", "esi_31_dp", "esi_36_dp"),
|
||||
FR = c("esi_09_fr", "esi_18_fr", "esi_23_fr", "esi_28_fr", "esi_33_fr")
|
||||
)
|
||||
|
||||
ESI_SUBSKALEN_NAMEN = c(
|
||||
AS = "Aufmerksamkeits-/Sprachbeeinträchtigung",
|
||||
AU = "Akustische Unsicherheit",
|
||||
IR = "Beziehungsideen",
|
||||
DP = "Wahrnehmungsabweichung",
|
||||
FR = "Offenheit (Kontrollskala)"
|
||||
)
|
||||
|
||||
ESI_SUBSKALEN_RANGE = c(AS = "0-30", AU = "0-24", IR = "0-21", DP = "0-27", FR = "0-15")
|
||||
|
||||
ESI_NORM_TABELLE = data.frame(
|
||||
skala = rep(c("AS", "AU", "IR", "DP", "FR"), each = 3),
|
||||
gruppe = rep(c("SCH", "MIX", "CON"), times = 5),
|
||||
m = c(7.74, 5.27, 1.98, 5.47, 2.24, 1.14, 5.23, 1.66, 0.76,
|
||||
5.13, 2.63, 1.66, 5.79, 6.57, 7.19),
|
||||
sd = c(6.51, 4.81, 2.55, 5.03, 3.13, 1.68, 5.16, 2.59, 1.59,
|
||||
5.39, 2.93, 2.52, 3.32, 3.25, 3.26),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
ESI_GRUPPEN_NAMEN = c(SCH = "akut Schizophrene", MIX = "psychiatr. Vergleichsgruppe", CON = "Gesunde")
|
||||
|
||||
# Fertige Rohscore-Grenzen aus dem Manual (Bezugsgruppe CON), nicht selbst
|
||||
# aus M/SD neu berechnet.
|
||||
ESI_CUTOFF_TABELLE = data.frame(
|
||||
skala = c("AS", "AU", "IR", "DP"),
|
||||
normal_bis = c(3, 2, 0, 3),
|
||||
erhoeht_bis = c(8, 6, 5, 8),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
ESI_KONTEXT_OPTIONEN = c(
|
||||
"Ambulantes Screening (Vergleich: Gesunde)" = "CON",
|
||||
"Verlaufsbeurteilung bei gesicherter Diagnose (Vergleich: akut Schizophrene)" = "SCH",
|
||||
"Differentialdiagnostik (Vergleich: psychiatrische Vergleichsgruppe)" = "MIX"
|
||||
)
|
||||
|
||||
|
||||
# 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-nr { font-weight: 600; color: #8B2635; min-width: 26px; flex-shrink: 0; }
|
||||
.item-text { flex: 1; color: #333; font-size: 0.92em; }
|
||||
.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;
|
||||
}
|
||||
.norm-hinweis { font-size: 0.82em; color: #888; font-style: italic; margin-bottom: 10px; }
|
||||
.subskala-zeile {
|
||||
display: flex; align-items: center; gap: 14px; flex-wrap: wrap;
|
||||
padding: 10px 0; border-bottom: 1px solid #F0F0F0;
|
||||
}
|
||||
.subskala-name { font-weight: 700; color: #333; min-width: 260px; }
|
||||
.subskala-wert { font-size: 1.3rem; font-weight: 800; color: #8B2635; min-width: 50px; }
|
||||
.norm-tabelle { font-size: 0.85em; color: #555; }
|
||||
.norm-tabelle .aktiv { font-weight: 700; color: #222; }
|
||||
.cutoff-badge-normal, .cutoff-badge-erhoeht, .cutoff-badge-extrem {
|
||||
border-radius: 4px; padding: 2px 10px; font-weight: 700;
|
||||
font-size: 0.82em; white-space: nowrap; display: inline-block;
|
||||
}
|
||||
.cutoff-badge-normal { background: #4CAF50; color: white; }
|
||||
.cutoff-badge-erhoeht { background: #E65100; color: white; }
|
||||
.cutoff-badge-extrem { background: #B71C1C; color: white; }
|
||||
.item-wert-badge-0, .item-wert-badge-1, .item-wert-badge-2, .item-wert-badge-3 {
|
||||
border-radius: 4px; padding: 2px 9px; font-weight: 700;
|
||||
font-size: 0.82em; white-space: nowrap; display: inline-block; flex-shrink: 0;
|
||||
}
|
||||
.item-wert-badge-0 { background: #4CAF50; color: white; }
|
||||
.item-wert-badge-1 { background: #F48FB1; color: #333333; }
|
||||
.item-wert-badge-2 { background: #EF5350; color: white; }
|
||||
.item-wert-badge-3 { background: #B71C1C; color: white; }
|
||||
.item-details summary {
|
||||
cursor: pointer; font-weight: 600; color: #555; font-size: 0.88em;
|
||||
margin-top: 8px; list-style: none;
|
||||
}
|
||||
.item-details summary::-webkit-details-marker { display: none; }
|
||||
.item-details summary::before { content: \"▸ \"; }
|
||||
.item-details[open] summary::before { content: \"▾ \"; }
|
||||
.item-details .item-liste { 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("ESI – Eppendorfer Schizophrenie Inventar"),
|
||||
tags$p("Standardversion, 40 Items | Einzelfallauswertung")
|
||||
),
|
||||
|
||||
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 = "abschnitt-karte",
|
||||
div(style = "font-weight: 600; color: #333; margin-bottom: 8px;", "Klinischer Kontext"),
|
||||
selectInput("kontext", label = NULL, choices = names(ESI_KONTEXT_OPTIONEN),
|
||||
selected = names(ESI_KONTEXT_OPTIONEN)[1], width = "100%"),
|
||||
div(class = "norm-hinweis",
|
||||
"Komfort-Funktion zur optischen Hervorhebung der jeweils passenden Referenzgruppe. ",
|
||||
"Alle drei Referenzgruppen bleiben stets sichtbar.")
|
||||
),
|
||||
|
||||
uiOutput("fehler_ui"),
|
||||
uiOutput("mehrere_ui"),
|
||||
uiOutput("warnung_ui"),
|
||||
uiOutput("ergebnis_ui")
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
# Word-Export ####
|
||||
|
||||
erstelle_ESI_docx = function(erg) {
|
||||
doc = read_docx()
|
||||
|
||||
fp_titel = fp_text(color = AKZENT_FARBE, bold = TRUE, font.size = 18)
|
||||
fp_abschnitt = fp_text(color = AKZENT_FARBE, bold = TRUE, font.size = 13)
|
||||
fp_label = fp_text(bold = TRUE, font.size = 11)
|
||||
fp_normal = fp_text(font.size = 11)
|
||||
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
||||
fp_warnung = fp_text(font.size = 10, bold = TRUE, color = "#BF360C", shading.color = "#FFF3E0")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("ESI – Einzelauswertung", 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)
|
||||
))
|
||||
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")
|
||||
|
||||
if (isTRUE(erg$fragwuerdig)) {
|
||||
doc = body_add_fpar(doc, fpar(ftext("Validitätshinweis", fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(ESI_VALIDITAETS_ZITAT, fp_warnung)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
"Die nachfolgenden Skalenwerte werden dennoch angezeigt, sind aber unter Vorbehalt zu interpretieren.",
|
||||
fp_text(font.size = 10, italic = TRUE, color = "#BF360C")
|
||||
)))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
}
|
||||
|
||||
interpretation = esi_gesamt_interpretation(erg$gesamtscore)
|
||||
fp_score = if (interpretation$stufe == "unauffaellig")
|
||||
fp_text(bold = TRUE, font.size = 12, color = "#2E7D32")
|
||||
else
|
||||
fp_text(bold = TRUE, font.size = 12, color = "#C62828")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Gesamtscore (AS+AU+IR+DP)", fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(erg$gesamtscore, " / 102"), fp_score)
|
||||
))
|
||||
doc = body_add_fpar(doc, fpar(ftext(interpretation$text, fp_normal)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(ESI_GESAMT_DISCLAIMER, fp_disclaimer)))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Subskalen", fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(ESI_NORM_HINWEIS, fp_disclaimer)))
|
||||
|
||||
for (sk in c("AS", "AU", "IR", "DP", "FR")) {
|
||||
wert = erg$subskalen[[sk]]
|
||||
zeile_txt = paste0(ESI_SUBSKALEN_NAMEN[[sk]], " (", sk, "): ", wert,
|
||||
" (Range ", ESI_SUBSKALEN_RANGE[[sk]], ")")
|
||||
if (sk != "FR") {
|
||||
stufe = esi_cutoff_stufe(sk, wert)
|
||||
zeile_txt = paste0(zeile_txt, " – Einordnung: ", esi_cutoff_label[[stufe]])
|
||||
}
|
||||
doc = body_add_fpar(doc, fpar(ftext(zeile_txt, fp_label)))
|
||||
|
||||
norm_zeile = ESI_NORM_TABELLE[ESI_NORM_TABELLE$skala == sk, ]
|
||||
norm_txt = paste0(
|
||||
"Vergleich (M/SD): ",
|
||||
paste(sapply(seq_len(nrow(norm_zeile)), function(i) {
|
||||
paste0(norm_zeile$gruppe[i], " ", ESI_GRUPPEN_NAMEN[[norm_zeile$gruppe[i]]],
|
||||
" = ", norm_zeile$m[i], " (", norm_zeile$sd[i], ")")
|
||||
}), collapse = " | ")
|
||||
)
|
||||
doc = body_add_fpar(doc, fpar(ftext(norm_txt, fp_normal)))
|
||||
|
||||
# Items der Skala nach Rohwert absteigend sortiert (auffaelligste zuerst).
|
||||
sk_items = ESI_SUBSKALEN[[sk]]
|
||||
sk_werte = erg$rohwerte[sk_items]
|
||||
sk_sortiert = sk_items[order(sk_werte, decreasing = TRUE, na.last = TRUE)]
|
||||
|
||||
for (var in sk_sortiert) {
|
||||
item_wert = erg$rohwerte[[var]]
|
||||
item_txt = erg$item_texte[[var]]
|
||||
if (is.na(item_txt)) item_txt = var
|
||||
wert_key = if (!is.na(item_wert) && item_wert %in% 0:3) as.character(as.integer(item_wert)) else "0"
|
||||
fp_item_badge = fp_text(
|
||||
bold = TRUE,
|
||||
font.size = 10,
|
||||
color = ESI_BADGE_TEXT_FARBEN[[wert_key]],
|
||||
shading.color = ESI_BADGE_FARBEN[[wert_key]]
|
||||
)
|
||||
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(esi_item_nummer(var), ". ", item_txt, " "), fp_normal),
|
||||
ftext(paste0(" ", if (is.na(item_wert)) "k.A." else as.integer(item_wert), " "), fp_item_badge)
|
||||
))
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
}
|
||||
|
||||
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 Chiffre oder Pseudonym eingeben."))
|
||||
}
|
||||
if (nchar(trimws(input$pseudonym)) == 0 && !grepl("^[A-Z][0-9]{6}$", chiffre)) {
|
||||
return(list(error = paste0(
|
||||
"Ungültige Chiffre. Erwartet: ein Grossbuchstabe + 6 Ziffern (z.B. P000123).")))
|
||||
}
|
||||
|
||||
if (!file.exists(PFAD_DOWNLOAD_SKRIPT)) {
|
||||
return(list(error = paste0("Download-Skript nicht gefunden:\n", PFAD_DOWNLOAD_SKRIPT)))
|
||||
}
|
||||
if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) {
|
||||
return(list(error = paste0("Pseudonym-Skript nicht gefunden:\n", PFAD_PSEUDONYM_SKRIPT)))
|
||||
}
|
||||
|
||||
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); 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_esi", envir = .GlobalEnv)) {
|
||||
return(list(error = paste0(
|
||||
"Objekt 'daten_esi' 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_esi", envir = .GlobalEnv)
|
||||
pseudo_df = get("pseudo", envir = .GlobalEnv)
|
||||
|
||||
if (nchar(trimws(input$pseudonym)) > 0) {
|
||||
pw_treffer = pseudo_df[pseudo_df$pseudonym == trimws(input$pseudonym), ]
|
||||
if (nrow(pw_treffer) > 0) {
|
||||
chiffre = toupper(trimws(pw_treffer$chiffre[1]))
|
||||
} else if (nchar(chiffre) == 0) {
|
||||
return(list(error = paste0(
|
||||
"Pseudonym '", trimws(input$pseudonym), "' wurde in der Pseudonym-Datenbank nicht gefunden.")))
|
||||
}
|
||||
}
|
||||
|
||||
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)
|
||||
|
||||
session_spalte = esi_finde_session_spalte(daten)
|
||||
if (is.na(session_spalte)) {
|
||||
return(list(error = paste0(
|
||||
"Keine Session-Spalte in 'daten_esi' gefunden (erwartet z.B. 'session'). ",
|
||||
"Bitte Download-Skript prüfen.")))
|
||||
}
|
||||
|
||||
treffer_dat = daten[daten[[session_spalte]] %in% alle_session_ids, ]
|
||||
if (nrow(treffer_dat) == 0) {
|
||||
return(list(error = paste0(
|
||||
"Kein ESI-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)
|
||||
|
||||
# Datum pro Zeile ueber die echte Kandidaten-Erkennung parsen (nicht
|
||||
# lexikografisch auf dem Rohstring sortieren - Format ist ungewiss).
|
||||
datums_werte = as.Date(rep(NA, nrow(treffer_dat)))
|
||||
for (i in seq_len(nrow(treffer_dat))) {
|
||||
datums_werte[i] = esi_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 Ausfüllungen gefunden (", n, " Einträge). ",
|
||||
"Angezeigt wird die neueste vom ", datum_neu_str, "."
|
||||
)
|
||||
treffer_dat = treffer_dat[1, , drop = FALSE]
|
||||
}
|
||||
|
||||
zeile = treffer_dat[1, , drop = FALSE]
|
||||
|
||||
ausfuelldatum = esi_finde_ausfuelldatum(zeile)
|
||||
datum_str = if (!is.na(ausfuelldatum)) format(ausfuelldatum, "%d.%m.%Y") else
|
||||
paste0(format(Sys.Date(), "%d.%m.%Y"), " (Ausfüllsdatum nicht ermittelbar)")
|
||||
|
||||
ergebnis = esi_berechne(daten, zeile)
|
||||
|
||||
item_texte = setNames(
|
||||
sapply(names(ergebnis$rohwerte), function(v) esi_item_text(daten, v)),
|
||||
names(ergebnis$rohwerte)
|
||||
)
|
||||
|
||||
list(
|
||||
chiffre = chiffre,
|
||||
datum_str = datum_str,
|
||||
ausfuelldatum = ausfuelldatum,
|
||||
info_mehrere = info_mehrere,
|
||||
subskalen = ergebnis$subskalen,
|
||||
rohwerte = ergebnis$rohwerte,
|
||||
item_texte = item_texte,
|
||||
gesamtscore = ergebnis$gesamtscore,
|
||||
esi40_gar_nicht = ergebnis$esi40_gar_nicht,
|
||||
fragwuerdig = ergebnis$fragwuerdig,
|
||||
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$mehrere_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$warnung_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (!is.null(d$error) || !isTRUE(d$fragwuerdig)) return(NULL)
|
||||
div(class = "alert-warnung",
|
||||
tags$strong("Validitätshinweis: "), ESI_VALIDITAETS_ZITAT,
|
||||
tags$br(),
|
||||
"Die nachfolgenden Skalenwerte werden dennoch angezeigt, sind aber unter Vorbehalt zu interpretieren."
|
||||
)
|
||||
})
|
||||
|
||||
output$ergebnis_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (!is.null(d$error)) return(NULL)
|
||||
|
||||
kontext_gruppe = if (!is.null(input$kontext) && input$kontext %in% names(ESI_KONTEXT_OPTIONEN))
|
||||
ESI_KONTEXT_OPTIONEN[[input$kontext]] else ESI_KONTEXT_OPTIONEN[[1]]
|
||||
interpretation = esi_gesamt_interpretation(d$gesamtscore)
|
||||
score_farbe = if (interpretation$stufe == "unauffaellig") "#2E7D32" else "#C62828"
|
||||
|
||||
subskalen_ui = lapply(c("AS", "AU", "IR", "DP", "FR"), function(sk) {
|
||||
wert = d$subskalen[[sk]]
|
||||
norm_zeile = ESI_NORM_TABELLE[ESI_NORM_TABELLE$skala == sk, ]
|
||||
|
||||
badge = if (sk != "FR") {
|
||||
stufe = esi_cutoff_stufe(sk, wert)
|
||||
span(class = paste0("cutoff-badge-", stufe), esi_cutoff_label[[stufe]])
|
||||
} else NULL
|
||||
|
||||
norm_spans = lapply(seq_len(nrow(norm_zeile)), function(i) {
|
||||
gruppe = norm_zeile$gruppe[i]
|
||||
txt = paste0(gruppe, ": ", norm_zeile$m[i], " (", norm_zeile$sd[i], ")")
|
||||
if (identical(gruppe, kontext_gruppe)) {
|
||||
tags$span(class = "aktiv", txt)
|
||||
} else {
|
||||
tags$span(txt)
|
||||
}
|
||||
})
|
||||
norm_zeile_ui = div(class = "norm-tabelle",
|
||||
Reduce(function(a, b) tagList(a, " | ", b), norm_spans)
|
||||
)
|
||||
|
||||
# Items der Skala nach Rohwert absteigend sortiert (auffaelligste zuerst).
|
||||
sk_items = ESI_SUBSKALEN[[sk]]
|
||||
sk_werte = d$rohwerte[sk_items]
|
||||
sk_items_sortiert = sk_items[order(sk_werte, decreasing = TRUE, na.last = TRUE)]
|
||||
|
||||
items_ui = lapply(sk_items_sortiert, function(var) {
|
||||
item_wert = d$rohwerte[[var]]
|
||||
item_txt = d$item_texte[[var]]
|
||||
if (is.na(item_txt)) item_txt = var
|
||||
wert_key = if (!is.na(item_wert) && item_wert %in% 0:3) as.character(as.integer(item_wert)) else "0"
|
||||
|
||||
div(class = "item-zeile",
|
||||
div(class = "item-nr", paste0(esi_item_nummer(var), ".")),
|
||||
div(class = "item-text", item_txt),
|
||||
span(class = paste0("item-wert-badge-", wert_key),
|
||||
if (is.na(item_wert)) "k.A." else as.integer(item_wert))
|
||||
)
|
||||
})
|
||||
|
||||
items_details = tags$details(class = "item-details",
|
||||
tags$summary("Items anzeigen"),
|
||||
div(class = "item-liste", items_ui)
|
||||
)
|
||||
|
||||
div(class = "subskala-zeile",
|
||||
div(class = "subskala-name", paste0(ESI_SUBSKALEN_NAMEN[[sk]], " (", sk, ")")),
|
||||
div(class = "subskala-wert", wert),
|
||||
badge,
|
||||
div(style = "flex-basis: 100%; margin-top: 4px;", norm_zeile_ui),
|
||||
div(style = "flex-basis: 100%;", items_details)
|
||||
)
|
||||
})
|
||||
|
||||
div(
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "ESI – Ergebnis"),
|
||||
div(class = "meta-block",
|
||||
tags$strong("Chiffre: "), d$chiffre,
|
||||
tags$span(" | ", style = "color:#ccc;"),
|
||||
tags$strong("Ausfüllsdatum: "), d$datum_str
|
||||
),
|
||||
tags$hr(),
|
||||
div(
|
||||
div(class = "score-zahl", style = paste0("color:", score_farbe, ";"), d$gesamtscore),
|
||||
div("Gesamtscore (AS+AU+IR+DP), Range 0-102", style = "color:#555;"),
|
||||
div(style = paste0("margin-top: 6px; font-weight: 600; color:", score_farbe, ";"),
|
||||
interpretation$text)
|
||||
),
|
||||
div(class = "disclaimer-text", ESI_GESAMT_DISCLAIMER)
|
||||
),
|
||||
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "Subskalen"),
|
||||
div(class = "norm-hinweis", ESI_NORM_HINWEIS),
|
||||
div(subskalen_ui)
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
output$download_word = downloadHandler(
|
||||
filename = function() {
|
||||
d = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
chiffre = if (is.list(d) && is.null(d$error) && nchar(d$chiffre) > 0) d$chiffre else "export"
|
||||
datum = if (is.list(d) && is.null(d$error) && !is.na(d$ausfuelldatum))
|
||||
format(d$ausfuelldatum, "%Y%m%d")
|
||||
else
|
||||
format(Sys.Date(), "%Y%m%d")
|
||||
paste0("ESI_", chiffre, "_", 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 oder Pseudonym eingeben und 'Auswerten' klicken.",
|
||||
style = "Normal")
|
||||
print(doc, target = file)
|
||||
return()
|
||||
}
|
||||
doc = tryCatch(
|
||||
erstelle_ESI_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