Initial commit
This commit is contained in:
commit
3cba772836
1341 changed files with 532924 additions and 0 deletions
870
ADHS-Funktionsniveau/app.R
Normal file
870
ADHS-Funktionsniveau/app.R
Normal file
|
|
@ -0,0 +1,870 @@
|
|||
# Praeambel ####
|
||||
|
||||
AKZENT_FARBE = "#8B2635"
|
||||
FARBE_GUT = "#4CAF50"
|
||||
FARBE_SCHLECHT = "#B71C1C"
|
||||
|
||||
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_adhs_funktionsniveau.R" # liefert: daten_adhs_funktionsniveau
|
||||
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R" # liefert: pseudo
|
||||
|
||||
ADHS_FUNKTIONSNIVEAU_DISCLAIMER = paste0(
|
||||
"Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
|
||||
"keine klinische Diagnose. Es liegen keine publizierten Normwerte oder Cutoffs zu diesem ",
|
||||
"Instrument vor, die Darstellung ist rein deskriptiv. Die Interpretation obliegt der ",
|
||||
"behandelnden Person."
|
||||
)
|
||||
|
||||
ADHS_FUNKTIONSNIVEAU_RICHTUNGSHINWEIS = paste0(
|
||||
"Achtung Codierungsrichtung: Hohe Werte bedeuten ein schlechteres Funktionsniveau, ",
|
||||
"niedrige Werte ein besseres. Dies ist gegenlaeufig zu vielen anderen Instrumenten."
|
||||
)
|
||||
|
||||
library(shiny)
|
||||
library(dplyr)
|
||||
library(ggplot2)
|
||||
library(haven)
|
||||
library(officer)
|
||||
|
||||
|
||||
# Infrastruktur ####
|
||||
|
||||
APP_VERZEICHNIS = normalizePath(getwd())
|
||||
|
||||
absPath = function(pfad) {
|
||||
if (grepl("^([A-Za-z]:[/\\\\]|/)", pfad)) return(pfad)
|
||||
file.path(APP_VERZEICHNIS, pfad)
|
||||
}
|
||||
|
||||
PFAD_DOWNLOAD_SKRIPT = normalizePath(absPath(PFAD_DOWNLOAD_SKRIPT), mustWork = FALSE)
|
||||
PFAD_PSEUDONYM_SKRIPT = normalizePath(absPath(PFAD_PSEUDONYM_SKRIPT), mustWork = FALSE)
|
||||
|
||||
|
||||
# Helper ####
|
||||
|
||||
# UNVERIFIZIERTE ANNAHME (siehe Abschnitt 4, Punkt 1 der Spezifikation): Es ist nicht durch
|
||||
# einen echten formr-Testdurchlauf bestaetigt, ob range_ticks-Items numerisch oder als
|
||||
# haven_labelled (dbl+lbl) exportiert werden. Diese Funktion faengt beide Faelle ab und
|
||||
# liefert immer entweder einen validen Wert 1-10 oder einen expliziten Status.
|
||||
hole_range_wert = function(rohwert) {
|
||||
if (is.null(rohwert) || length(rohwert) == 0) return(list(wert = NA_real_, status = "fehlt"))
|
||||
wert_roh = rohwert[1]
|
||||
if (is.na(wert_roh)) return(list(wert = NA_real_, status = "fehlt"))
|
||||
if (inherits(wert_roh, "haven_labelled")) wert_roh = haven::zap_labels(wert_roh)
|
||||
wert = suppressWarnings(as.numeric(wert_roh))
|
||||
if (is.na(wert) || wert < 1 || wert > 10) return(list(wert = NA_real_, status = "ungueltig"))
|
||||
list(wert = wert, status = "ok")
|
||||
}
|
||||
|
||||
# UNVERIFIZIERTE ANNAHME (siehe Abschnitt 4, Punkt 2 der Spezifikation): Es ist nicht durch
|
||||
# einen echten formr-Testdurchlauf bestaetigt, in welchem Format check-Items exportiert werden
|
||||
# (TRUE/FALSE, 1/0/NA oder Zeichenkette). Alle plausiblen Formen werden abgefangen.
|
||||
ist_angekreuzt = function(x) {
|
||||
if (is.null(x) || length(x) == 0) return(FALSE)
|
||||
wert = x[1]
|
||||
if (is.na(wert)) return(FALSE)
|
||||
wert_norm = tolower(trimws(as.character(wert)))
|
||||
wert_norm %in% c("true", "1")
|
||||
}
|
||||
|
||||
farbverlauf_funktion = colorRampPalette(c(FARBE_GUT, FARBE_SCHLECHT))
|
||||
|
||||
farbe_funktionsniveau = function(wert, min_wert, max_wert) {
|
||||
if (is.null(wert) || length(wert) == 0 || is.na(wert)) return("#CCCCCC")
|
||||
frac = (wert - min_wert) / (max_wert - min_wert)
|
||||
frac = max(0, min(1, frac))
|
||||
farbverlauf_funktion(101)[round(frac * 100) + 1]
|
||||
}
|
||||
|
||||
make_profil_plot = function(df) {
|
||||
ggplot(df, aes(x = reorder(label, -kat_nr), y = summe, fill = summe)) +
|
||||
geom_col(width = 0.6, na.rm = TRUE) +
|
||||
coord_flip(clip = "off") +
|
||||
scale_fill_gradient(low = FARBE_GUT, high = FARBE_SCHLECHT, limits = c(0, 20), guide = "none") +
|
||||
scale_y_continuous(limits = c(0, 20), breaks = seq(0, 20, 5),
|
||||
expand = expansion(mult = c(0, 0.18))) +
|
||||
geom_text(aes(label = beschriftung), hjust = -0.05, size = 3.3, color = "#333333") +
|
||||
labs(x = NULL, y = "Summenwert je Kategorie (0-20, hoch = schlechteres Funktionieren)") +
|
||||
theme_minimal(base_size = 12) +
|
||||
theme(
|
||||
panel.grid.major.y = element_blank(),
|
||||
panel.grid.minor = element_blank(),
|
||||
plot.margin = margin(t = 5, r = 60, b = 5, l = 5)
|
||||
)
|
||||
}
|
||||
|
||||
make_kat10_plot = function(wert) {
|
||||
df = data.frame(x = "Kategorie 10", y = wert)
|
||||
ggplot(df, aes(x = x, y = y, fill = y)) +
|
||||
geom_col(width = 0.5, na.rm = TRUE) +
|
||||
coord_flip(clip = "off", ylim = c(1, 10)) +
|
||||
scale_fill_gradient(low = FARBE_GUT, high = FARBE_SCHLECHT, limits = c(1, 10), guide = "none") +
|
||||
scale_y_continuous(breaks = 1:10,
|
||||
expand = expansion(mult = c(0, 0.12))) +
|
||||
geom_text(aes(label = y), hjust = -0.3, size = 4.2, fontface = "bold", color = "#333333") +
|
||||
labs(x = NULL, y = "Kategorie 10: Allgemeine Funktionsfaehigkeit (1 = gut, 10 = schlecht)") +
|
||||
theme_minimal(base_size = 12) +
|
||||
theme(
|
||||
axis.text.y = element_blank(),
|
||||
axis.ticks.y = element_blank(),
|
||||
panel.grid.major.y = element_blank(),
|
||||
panel.grid.minor = element_blank(),
|
||||
plot.margin = margin(t = 5, r = 40, b = 5, l = 5)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
# Datenaufbereitung ####
|
||||
|
||||
# Feste Item-Referenztabelle Teil 1 (19 Items, 10 Kategorien). Wird nicht zur Laufzeit aus
|
||||
# den Daten abgeleitet, siehe Abschnitt 2 der Spezifikation.
|
||||
FUNKTIONSNIVEAU_KAT_NAMEN = c(
|
||||
"1" = "1. Ordnen",
|
||||
"2" = "2. Anfangen",
|
||||
"3" = "3. Umsetzen",
|
||||
"4" = "4. Einteilen",
|
||||
"5" = "5. Planen",
|
||||
"6" = "6. Erkennen / Entnehmen",
|
||||
"7" = "7. Gedaechtnis",
|
||||
"8" = "8. Soziales",
|
||||
"9" = "9. Sonstiges"
|
||||
)
|
||||
|
||||
FUNKTIONSNIVEAU_KAT_ITEMS = list(
|
||||
"1" = c("funktionsniveau_kat01_a", "funktionsniveau_kat01_b"),
|
||||
"2" = c("funktionsniveau_kat02_a", "funktionsniveau_kat02_b"),
|
||||
"3" = c("funktionsniveau_kat03_a", "funktionsniveau_kat03_b"),
|
||||
"4" = c("funktionsniveau_kat04_a", "funktionsniveau_kat04_b"),
|
||||
"5" = c("funktionsniveau_kat05_a", "funktionsniveau_kat05_b"),
|
||||
"6" = c("funktionsniveau_kat06_a", "funktionsniveau_kat06_b"),
|
||||
"7" = c("funktionsniveau_kat07_a", "funktionsniveau_kat07_b"),
|
||||
"8" = c("funktionsniveau_kat08_a", "funktionsniveau_kat08_b"),
|
||||
"9" = c("funktionsniveau_kat09_a", "funktionsniveau_kat09_b")
|
||||
)
|
||||
|
||||
FUNKTIONSNIVEAU_ITEM_TEXTE = c(
|
||||
funktionsniveau_kat01_a = "Wenn ich zwischen verschiedenen Moeglichkeiten entscheiden muss",
|
||||
funktionsniveau_kat01_b = "Wenn viele Dinge gleichzeitig zu tun sind",
|
||||
funktionsniveau_kat02_a = "Wenn ein laengerfristiges Vorhaben begonnen werden soll",
|
||||
funktionsniveau_kat02_b = "Wenn der erste Schritt bei einer Arbeit / einem Projekt gemacht werden soll",
|
||||
funktionsniveau_kat03_a = "Wenn eine Aufgabe puenktlich und wie verabredet erledigt werden soll",
|
||||
funktionsniveau_kat03_b = "Wenn Alltagsroutinen erledigt werden sollen (z.B. Aufraeumen, Einkaufen)",
|
||||
funktionsniveau_kat04_a = "Wenn es um Geld geht (z.B. Einteilen)",
|
||||
funktionsniveau_kat04_b = "Wenn es um den Tagesablauf und die Arbeitszeit geht",
|
||||
funktionsniveau_kat05_a = "Wenn etwas im Voraus geplant werden soll",
|
||||
funktionsniveau_kat05_b = "Wenn ein Schritt-fuer-Schritt-Vorgehen notwendig ist",
|
||||
funktionsniveau_kat06_a = "Wenn ich laenger zuhoeren und das Wesentliche verstehen will (z.B. im Gespraech)",
|
||||
funktionsniveau_kat06_b = "Wenn ich mich orientieren muss (z.B. in einer Stadt, in Schule oder Beruf)",
|
||||
funktionsniveau_kat07_a = "Wenn ich mir etwas merken will (z.B. Name, Zahlen, Termine)",
|
||||
funktionsniveau_kat07_b = "Wenn ich mich an etwas erinnern soll (z.B. Termin, Absprache, Aufgaben)",
|
||||
funktionsniveau_kat08_a = "Wenn ich in einer Gruppe bin (z.B. Freunde, Arbeitsgruppe)",
|
||||
funktionsniveau_kat08_b = "Wenn andere nicht mit mir uebereinstimmen, d.h. anderer Meinung sind",
|
||||
funktionsniveau_kat09_a = "Gelingt mir ... (Fortsetzung im Freitext)",
|
||||
funktionsniveau_kat09_b = "Gelingt mir ... (Fortsetzung im Freitext)",
|
||||
funktionsniveau_kat10 = "Meine Leistungsfaehigkeit und geistige Gesundheit sind (gut - schlecht)"
|
||||
)
|
||||
|
||||
# Feste Item-Referenztabelle Teil 2 (116 Items, Zusatzfragen-Checkliste ohne Score),
|
||||
# siehe Abschnitt 3 der Spezifikation.
|
||||
ZUSATZFRAGEN_TEXTE = c(
|
||||
zusatzfragen_001 = "Ich bin Links- oder Beidhaender.",
|
||||
zusatzfragen_002 = "In meiner Familie gibt es Faelle von Drogen-/Alkoholmissbrauch, Depressionen oder manisch-depressiven Leiden.",
|
||||
zusatzfragen_003 = "Ich leide unter Stimmungsschwankungen.",
|
||||
zusatzfragen_004 = "Ich galt in der Schule oder gelte heute als leistungsschwach.",
|
||||
zusatzfragen_005 = "Ich habe Schwierigkeiten, Dinge anzufangen.",
|
||||
zusatzfragen_006 = "Ich trommle haeufig mit den Fingern, klopfe mit den Fuessen auf den Boden, zapple herum oder kann nicht still sitzen.",
|
||||
zusatzfragen_007 = "Ich bin sehr temperatur- oder geraeuschempfindlich.",
|
||||
zusatzfragen_008 = "Ich muss haeufig einen Absatz oder eine ganze Seite noch einmal lesen, weil ich mit offenen Augen traeume.",
|
||||
zusatzfragen_009 = "Ich habe haeufig Absencen oder Trancezustaende.",
|
||||
zusatzfragen_010 = "Meine Mutter hat waehrend der Schwangerschaft geraucht.",
|
||||
zusatzfragen_011 = "Es faellt mir schwer, mich zu entspannen.",
|
||||
zusatzfragen_012 = "Ich konnte mich als Kind nicht alleine beschaeftigen.",
|
||||
zusatzfragen_013 = "Ich bin extrem ungeduldig.",
|
||||
zusatzfragen_014 = "Ich konnte/kann nicht verlieren.",
|
||||
zusatzfragen_015 = "Ich musste als Kind unbedingt meinen Willen durchsetzen.",
|
||||
zusatzfragen_016 = "Meine Leistungsfaehigkeit schwankt extrem.",
|
||||
zusatzfragen_017 = "Ich fange viele Unternehmungen gleichzeitig an, sodass ich oft mehr Baelle in der Luft habe als ich bewaeltigen kann.",
|
||||
zusatzfragen_018 = "Ich bin impulsiv.",
|
||||
zusatzfragen_019 = "Ich hielt mich als Kind nicht an Regeln.",
|
||||
zusatzfragen_020 = "Ich habe haeufiger die Schule geschwaenzt.",
|
||||
zusatzfragen_021 = "Meine Konzentrationsfaehigkeit laesst leicht nach.",
|
||||
zusatzfragen_022 = "Wenn mich etwas wirklich interessiert, habe ich eine extrem gute Konzentrationsfaehigkeit, obwohl sie sonst leicht nachlaesst.",
|
||||
zusatzfragen_023 = "Ich schiebe staendig Dinge auf die lange Bank.",
|
||||
zusatzfragen_024 = "Ich bin haeufig Feuer und Flamme fuer ein Projekt und bleibe dann doch nicht an der Sache dran.",
|
||||
zusatzfragen_025 = "Ich bin leicht ablenkbar durch Unwichtiges.",
|
||||
zusatzfragen_026 = "Ich bin im Besitz einer Fahrerlaubnis. Diese wurde mir schon einmal entzogen, ich wurde bereits mehrfach wegen erhoehter Geschwindigkeit oder schon einmal wegen Fahrens ohne Fahrerlaubnis belangt.",
|
||||
zusatzfragen_027 = "Ich war/bin motorisch sehr ungeschickt, d.h. ich stosse haeufig an, stolpere, ziehe mit Verletzungen zu etc.",
|
||||
zusatzfragen_028 = "Es faellt mir schwerer als den meisten Menschen, mich verstaendlich zu machen.",
|
||||
zusatzfragen_029 = "Mein Gedaechtnis ist so loechrig, dass ich auf dem Weg von einem Zimmer ins andere manchmal vergesse, was ich dort holen wollte.",
|
||||
zusatzfragen_030 = "Ich bin Raucher.",
|
||||
zusatzfragen_031 = "In meiner Freizeit uebe ich einen Extremsport aus (z.B. Gleitschirmfliegen, Bungee Jumping, Motorsport).",
|
||||
zusatzfragen_032 = "Ich habe mindestens eine Klasse wiederholt.",
|
||||
zusatzfragen_033 = "Ich zerstoerte als Kind oefter mutwillig Spielsachen oder Gegenstaende.",
|
||||
zusatzfragen_034 = "Ich trinke zu viel Alkohol.",
|
||||
zusatzfragen_035 = "Ich bin in Kindheit/Jugend mit Stehlen oder Zuendeln aufgefallen.",
|
||||
zusatzfragen_036 = "Kokain/Amphetamin macht mich nicht high, sondern ruhiger und verbessert meine Konzentrationsfaehigkeit.",
|
||||
zusatzfragen_037 = "Ich litt unter Bettnaessen.",
|
||||
zusatzfragen_038 = "Ich zappe in Radio/Fernsehen haeufig umher.",
|
||||
zusatzfragen_039 = "Ich fuehle mich getrieben, als ob in meinem Inneren staendig ein Motor liefe.",
|
||||
zusatzfragen_040 = 'Als Kind wurde ich z.B. "faul", "impulsiv", "aggressiv" oder einfach "boese" genannt.',
|
||||
zusatzfragen_041 = "Meine engeren Beziehungen sind belastet durch meine Unfaehigkeit, mich ueber laengere Zeit an einem Gespraech zu beteiligen.",
|
||||
zusatzfragen_042 = "Ich bin immer in Bewegung, auch wenn ich es gar nicht moechte.",
|
||||
zusatzfragen_043 = "Ich kann schlechter als andere Menschen warten, bis ich an der Reihe bin.",
|
||||
zusatzfragen_044 = "Ich bin nicht in der Lage, zuerst die Gebrauchsanweisung zu lesen, bevor ich anfange.",
|
||||
zusatzfragen_045 = "Ich bin eine Mimose.",
|
||||
zusatzfragen_046 = "Ich treibe exzessiv Sport.",
|
||||
zusatzfragen_047 = "Ich muss dauernd aufpassen, dass ich nicht mit etwas Falschem herausplatze.",
|
||||
zusatzfragen_048 = "Ich war/bin Schlafwandler.",
|
||||
zusatzfragen_049 = "Ich liebe Gluecksspiel.",
|
||||
zusatzfragen_050 = "Ich habe das Gefuehl, innerlich in die Luft zu gehen, wenn jemand Muehe hat, zur Sache zu kommen.",
|
||||
zusatzfragen_051 = "Ich war als Kind motorisch sehr unruhig (hyperaktiv).",
|
||||
zusatzfragen_052 = "Spannende Situationen mit ziehen mich magisch an.",
|
||||
zusatzfragen_053 = "Ich versuche haeufig, eher die Dinge zu tun, die mir schwer fallen, als die, die mir leicht fallen.",
|
||||
zusatzfragen_054 = 'Ich handle ueberwiegend "aus dem Bauch heraus" (intuitiv).',
|
||||
zusatzfragen_055 = "Ich gerate haeufig in eine Lage, in die ich gar nicht geraten will.",
|
||||
zusatzfragen_056 = "Ich wuerde mich lieber einer Wurzelbehandlung beim Zahnarzt unterziehen als nach Plan vorzugehen.",
|
||||
zusatzfragen_057 = "Ich beschliesse dauernd, mein Leben besser zu organisieren, nur um festzustellen, dass ich mich staendig am Rande des Chaos befinde.",
|
||||
zusatzfragen_058 = 'Ich habe haeufig einen Juckreiz, den ich nicht beseitigen kann, oder Appetit auf "mehr von irgendetwas", und ich weiss nicht wovon.',
|
||||
zusatzfragen_059 = "Ich bin uebersexualisiert, d.h. ich denke z.B. sehr viel an Sex oder interessiere mich auffallend fuer Themen wie Prostitution.",
|
||||
zusatzfragen_060 = "Ich neige zu Suchtverhalten.",
|
||||
zusatzfragen_061 = "Ich kann einen Menschen verstehen, der die ungewoehnliche Symptomentrias Kokainmissbrauch, haeufige Lektuere pornografischer Schriften und Sucht nach Kreuzwortraetseln aufweist, auch wenn ich selbst diese Symptome nicht habe.",
|
||||
zusatzfragen_062 = "Ich flirte mehr als ich eigentlich will.",
|
||||
zusatzfragen_063 = "Ich bin in einer chaotischen, undisziplinierten Familie aufgewachsen.",
|
||||
zusatzfragen_064 = "Es faellt mir schwer, alleine zu sein.",
|
||||
zusatzfragen_065 = "Ich bekaempfe depressive Verstimmungen haeufig durch irgendwelche moeglicherweise schaedlichen zwanghaften Verhaltensweisen (z.B. zu viel Arbeit, unkontrollierte Geldausgaben, zu viel Essen oder Trinken).",
|
||||
zusatzfragen_066 = "Ich habe eine Lese-Rechtschreibschwaeche (Legasthenie) oder eine Rechenschwaeche (Dyskalkulie).",
|
||||
zusatzfragen_067 = 'Bei einem Verwandten ersten Grades (z.B. Eltern, Geschwister, Kinder) wurde schon einmal "Aktivitaets- und Aufmerksamkeitsstoerung" (ADS) oder "Hyperaktivitaet" (ADHS) diagnostiziert.',
|
||||
zusatzfragen_068 = "Ich habe grosse Probleme, Frustrationen zu ertragen.",
|
||||
zusatzfragen_069 = 'Ich bin unruhig, wenn es in meinem Leben keine "Action" gibt.',
|
||||
zusatzfragen_070 = "Ich habe Muehe, ein Buch ganz zu lesen.",
|
||||
zusatzfragen_071 = "Ich kann besser mit den Folgen von Regelverstoessen leben als mit der Frustration, die das Befolgen von Vorschriften und Regeln fuer mich bedeuten wuerde.",
|
||||
zusatzfragen_072 = "Ich habe viele irrationale Aengste.",
|
||||
zusatzfragen_073 = "Ich bringe oft Buchstaben in Woertern oder Ziffern in Zahlen durcheinander.",
|
||||
zusatzfragen_074 = "Ich habe als Autofahrer schon mehr als vier Unfaelle verschuldet.",
|
||||
zusatzfragen_075 = "Ich kann schlecht mit Geld umgehen.",
|
||||
zusatzfragen_076 = "Ich bin der stuermische, dynamische Typ.",
|
||||
zusatzfragen_077 = "In meinem Leben gibt es nur wenig Strukturiertheit und Schematismus, obwohl beides eine beruhigende Wirkung auf mich ausuebt.",
|
||||
zusatzfragen_078 = "Ich bin oefter als einmal geschieden.",
|
||||
zusatzfragen_079 = "Ich habe Selbstwertprobleme.",
|
||||
zusatzfragen_080 = "Ich habe eine schlechte visuomotorische Koordination, d.h. ich kann die durch Sehen aufgenommene Informationen (Input) schlecht mit der Motorik (Output) in Einklang bringen.",
|
||||
zusatzfragen_081 = "Ich war als Kind sehr unsportlich.",
|
||||
zusatzfragen_082 = "Ich habe haeufig meinen Arbeitsplatz gekuendigt oder bin gekuendigt worden.",
|
||||
zusatzfragen_083 = "Ich bin Einzelgaenger.",
|
||||
zusatzfragen_084 = "Ich finde es fast unmoeglich, ein Adressbuch oder eine Adresskartei zu fuehren.",
|
||||
zusatzfragen_085 = "Ich bin an einem Tag die Stimmungskanone auf einer Party und schaeme mich am naechsten Tag dafuer.",
|
||||
zusatzfragen_086 = "Unerwartet freie Zeit weiss ich haeufig nicht sinnvoll zu nutzen oder fuehle mich dann deprimiert.",
|
||||
zusatzfragen_087 = "Ich bin kreativer und phantasievoller als die meisten Menschen.",
|
||||
zusatzfragen_088 = "Ich habe staendig Probleme, aufmerksam zu sein oder bei der Stange zu bleiben.",
|
||||
zusatzfragen_089 = "Ich arbeite am besten in kurzen Schueben.",
|
||||
zusatzfragen_090 = "Ich ueberziehe regelmaessig mein Konto.",
|
||||
zusatzfragen_091 = "Ich will unbedingt immer etwas Neues ausprobieren.",
|
||||
zusatzfragen_092 = "Nach einem Erfolg bin ich haeufig deprimiert.",
|
||||
zusatzfragen_093 = 'Ich suche haeufig nach dem "Nonplusultra".',
|
||||
zusatzfragen_094 = "Ich habe das Gefuehl, haeufig hinter meinen Moeglichkeiten zurueckzubleiben.",
|
||||
zusatzfragen_095 = "Ich fuehle mich besonders ratlos.",
|
||||
zusatzfragen_096 = 'Ich war in der Schule ein "Tagtraeumer" bzw. "Hans-guck-in-die-Luft".',
|
||||
zusatzfragen_097 = 'Ich war manchmal der "Klassenclown".',
|
||||
zusatzfragen_098 = 'Ich wurde schon einmal als "gierig" oder "unersaettlich" bezeichnet.',
|
||||
zusatzfragen_099 = "Ich kann meine Wirkung auf andere Menschen nur sehr schwer einschaetzen.",
|
||||
zusatzfragen_100 = "Ich gehe Probleme meist intuitiv an.",
|
||||
zusatzfragen_101 = "Ich suche einen Weg lieber nach Gefuehl als eine Karte zur Orientierung zu benutzen.",
|
||||
zusatzfragen_102 = "Ich bin beim Geschlechtsverkehr haeufig abgelenkt, obwohl ich Sex mag.",
|
||||
zusatzfragen_103 = "Ich bin ein Adoptivkind.",
|
||||
zusatzfragen_104 = "Ich leide unter Neurodermitis, Allergien oder Asthma.",
|
||||
zusatzfragen_105 = "Ich hatte als Kind haeufig Ohrinfektionen.",
|
||||
zusatzfragen_106 = "Ich arbeite effizienter, wenn ich mein eigener Chef bin.",
|
||||
zusatzfragen_107 = "Ich bin intelligenter als ich mich praesentieren kann.",
|
||||
zusatzfragen_108 = "Ich bin besonders unsicher.",
|
||||
zusatzfragen_109 = "Ich kann Geheimnisse nur schwer fuer mich behalten.",
|
||||
zusatzfragen_110 = "Ich vergesse haeufig, was ich sagen will, in dem Moment, wo ich es sagen will.",
|
||||
zusatzfragen_111 = "Ich reise gerne.",
|
||||
zusatzfragen_112 = "Ich leide an Platzangst (Klaustrophobie).",
|
||||
zusatzfragen_113 = "Ich habe mich schon einmal gefragt, ob ich verrueckt bin.",
|
||||
zusatzfragen_114 = "Ich erfasse schnell den springenden Punkt einer Sache.",
|
||||
zusatzfragen_115 = "Ich lache viel.",
|
||||
zusatzfragen_116 = "Es bereite mir Schwierigkeiten, meine Aufmerksamkeit so lange auf diesen Fragebogen zu konzentrieren, dass ich ihn zu Ende lesen konnte."
|
||||
)
|
||||
|
||||
berechne_funktionsniveau_profil = function(zeile) {
|
||||
kategorien = lapply(names(FUNKTIONSNIVEAU_KAT_ITEMS), function(k) {
|
||||
item_namen = FUNKTIONSNIVEAU_KAT_ITEMS[[k]]
|
||||
einzelwerte = lapply(item_namen, function(nm) {
|
||||
rohwert = if (nm %in% names(zeile)) zeile[[nm]][1] else NULL
|
||||
hole_range_wert(rohwert)
|
||||
})
|
||||
gueltige = sapply(einzelwerte, function(e) if (e$status == "ok") e$wert else NA_real_)
|
||||
n_items = sum(!is.na(gueltige))
|
||||
summe = if (n_items > 0) sum(gueltige, na.rm = TRUE) else NA_real_
|
||||
n_ungueltig = sum(sapply(einzelwerte, function(e) e$status == "ungueltig"))
|
||||
|
||||
list(
|
||||
kat_nr = as.integer(k),
|
||||
label = FUNKTIONSNIVEAU_KAT_NAMEN[[k]],
|
||||
summe = summe,
|
||||
n_items = n_items,
|
||||
n_erwartet = length(item_namen),
|
||||
n_ungueltig = n_ungueltig,
|
||||
anzeigen = n_items > 0
|
||||
)
|
||||
})
|
||||
names(kategorien) = names(FUNKTIONSNIVEAU_KAT_ITEMS)
|
||||
|
||||
kat10_roh = if ("funktionsniveau_kat10" %in% names(zeile)) zeile[["funktionsniveau_kat10"]][1] else NULL
|
||||
kat10_werte = hole_range_wert(kat10_roh)
|
||||
|
||||
kat09_a_text = if ("funktionsniveau_kat09_a_text" %in% names(zeile))
|
||||
as.character(zeile[["funktionsniveau_kat09_a_text"]][1]) else NA_character_
|
||||
kat09_b_text = if ("funktionsniveau_kat09_b_text" %in% names(zeile))
|
||||
as.character(zeile[["funktionsniveau_kat09_b_text"]][1]) else NA_character_
|
||||
if (!is.na(kat09_a_text) && trimws(kat09_a_text) == "") kat09_a_text = NA_character_
|
||||
if (!is.na(kat09_b_text) && trimws(kat09_b_text) == "") kat09_b_text = NA_character_
|
||||
|
||||
list(
|
||||
kategorien = kategorien,
|
||||
kat10 = kat10_werte,
|
||||
kat09_texte = list(a = kat09_a_text, b = kat09_b_text)
|
||||
)
|
||||
}
|
||||
|
||||
kategorien_zu_df = function(kategorien) {
|
||||
zeilen = lapply(kategorien, function(k) {
|
||||
if (!k$anzeigen) return(NULL)
|
||||
beschriftung = if (k$n_items < k$n_erwartet) {
|
||||
paste0(k$summe, " (", k$n_items, " von ", k$n_erwartet, " Items)")
|
||||
} else {
|
||||
as.character(k$summe)
|
||||
}
|
||||
data.frame(
|
||||
kat_nr = k$kat_nr, label = k$label, summe = k$summe,
|
||||
beschriftung = beschriftung, n_ungueltig = k$n_ungueltig,
|
||||
n_items = k$n_items, n_erwartet = k$n_erwartet,
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
})
|
||||
zeilen = Filter(Negate(is.null), zeilen)
|
||||
if (length(zeilen) == 0) return(NULL)
|
||||
do.call(rbind, zeilen)
|
||||
}
|
||||
|
||||
extrahiere_zusatzfragen = function(zeile) {
|
||||
spalten = names(ZUSATZFRAGEN_TEXTE)
|
||||
treffer = Filter(function(nm) {
|
||||
if (!(nm %in% names(zeile))) return(FALSE)
|
||||
ist_angekreuzt(zeile[[nm]][1])
|
||||
}, spalten)
|
||||
if (length(treffer) == 0)
|
||||
return(data.frame(item = character(0), nr = integer(0), text = character(0),
|
||||
stringsAsFactors = FALSE))
|
||||
nrs = as.integer(sub("zusatzfragen_", "", treffer))
|
||||
df = data.frame(
|
||||
item = treffer,
|
||||
nr = nrs,
|
||||
text = unname(ZUSATZFRAGEN_TEXTE[treffer]),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
df[order(df$nr), ]
|
||||
}
|
||||
|
||||
|
||||
# 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; }
|
||||
#download_word {
|
||||
background: #8B2635; color: white; border: none;
|
||||
border-radius: 4px; padding: 8px 20px; font-weight: 600;
|
||||
}
|
||||
#download_word:hover { background: #6d1e29; color: white; }
|
||||
.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; }
|
||||
.richtungs-hinweis {
|
||||
background: #FFEBEE; border-left: 5px solid #B71C1C;
|
||||
padding: 10px 16px; border-radius: 4px; color: #B71C1C;
|
||||
margin-bottom: 14px; font-size: 0.93em; font-weight: 700;
|
||||
}
|
||||
.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: 32px; flex-shrink: 0; }
|
||||
.item-text { flex: 1; color: #333; font-size: 0.92em; }
|
||||
.kat-ungueltig-hinweis { font-size: 0.82em; color: #BF360C; margin: -6px 0 8px 4px; }
|
||||
"
|
||||
|
||||
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("ADHS-Funktionsniveau"),
|
||||
tags$p("Funktionsniveau-Skala (10 Kategorien, 19 Items) und Zusatzfragen-Checkliste (116 Items)")
|
||||
),
|
||||
|
||||
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_adhs_funktionsniveau_docx = function(d) {
|
||||
doc = read_docx()
|
||||
|
||||
fp_titel = fp_text(color = AKZENT_FARBE, bold = TRUE, font.size = 18)
|
||||
fp_abschnitt = fp_text(color = AKZENT_FARBE, bold = TRUE, font.size = 13)
|
||||
fp_label = fp_text(bold = TRUE, font.size = 11)
|
||||
fp_normal = fp_text(font.size = 11)
|
||||
fp_hinweis = fp_text(bold = TRUE, font.size = 10.5, color = "#B71C1C")
|
||||
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("ADHS-Funktionsniveau - Einzelauswertung", fp_titel)))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Chiffre: ", fp_label), ftext(d$chiffre, fp_normal),
|
||||
ftext(" Ausfuelldatum: ", fp_label), ftext(d$datum_str, fp_normal)
|
||||
))
|
||||
if (!is.null(d$ausfuelldatum_hinweis)) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(d$ausfuelldatum_hinweis,
|
||||
fp_text(font.size = 9, italic = TRUE, color = "#BF360C"))))
|
||||
}
|
||||
if (!is.null(d$info_mehrere)) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(d$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(ADHS_FUNKTIONSNIVEAU_RICHTUNGSHINWEIS, fp_hinweis)))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Funktionsniveau-Profil (Kategorien 1-9, Skala 0-20)", fp_abschnitt)))
|
||||
for (k in d$kategorien) {
|
||||
if (!k$anzeigen) {
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(k$label, ": "), fp_label),
|
||||
ftext("nicht ausgefuellt", fp_normal)
|
||||
))
|
||||
next
|
||||
}
|
||||
farbe = farbe_funktionsniveau(k$summe, 0, 20)
|
||||
fp_wert = fp_text(bold = TRUE, font.size = 11, color = "#FFFFFF", shading.color = farbe)
|
||||
zusatz_txt = if (k$n_items < k$n_erwartet)
|
||||
paste0(" (basiert auf ", k$n_items, " von ", k$n_erwartet, " moeglichen Items)") else ""
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(k$label, ": "), fp_label),
|
||||
ftext(paste0(" ", k$summe, " ", zusatz_txt, " "), fp_wert)
|
||||
))
|
||||
if (k$n_ungueltig > 0) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
paste0(" Hinweis: ", k$n_ungueltig, " Item(e) nicht auswertbar, in der Summe nicht beruecksichtigt."),
|
||||
fp_text(font.size = 9, italic = TRUE, color = "#BF360C"))))
|
||||
}
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Kategorie 10: Allgemeine Funktionsfaehigkeit (Skala 1-10)", fp_abschnitt)))
|
||||
if (d$kat10$status == "ok") {
|
||||
farbe10 = farbe_funktionsniveau(d$kat10$wert, 1, 10)
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(" ", d$kat10$wert, " / 10 "),
|
||||
fp_text(bold = TRUE, font.size = 12, color = "#FFFFFF", shading.color = farbe10))
|
||||
))
|
||||
} else if (d$kat10$status == "ungueltig") {
|
||||
doc = body_add_fpar(doc, fpar(ftext("Wert nicht auswertbar.", fp_normal)))
|
||||
} else {
|
||||
doc = body_add_fpar(doc, fpar(ftext("Nicht beantwortet.", fp_normal)))
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
if (!is.na(d$kat09_texte$a) || !is.na(d$kat09_texte$b)) {
|
||||
doc = body_add_fpar(doc, fpar(ftext("Freitext zu Kategorie 9 (Sonstiges)", fp_abschnitt)))
|
||||
if (!is.na(d$kat09_texte$a))
|
||||
doc = body_add_fpar(doc, fpar(ftext("a: ", fp_label), ftext(d$kat09_texte$a, fp_normal)))
|
||||
if (!is.na(d$kat09_texte$b))
|
||||
doc = body_add_fpar(doc, fpar(ftext("b: ", fp_label), ftext(d$kat09_texte$b, fp_normal)))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
}
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Zusatzfragen (Teil 2, ohne Score)", fp_abschnitt)))
|
||||
if (nrow(d$zusatzfragen) == 0) {
|
||||
doc = body_add_fpar(doc, fpar(ftext("Keine Zusatzfragen angekreuzt.", fp_normal)))
|
||||
} else {
|
||||
for (i in seq_len(nrow(d$zusatzfragen))) {
|
||||
row = d$zusatzfragen[i, ]
|
||||
doc = body_add_fpar(doc, fpar(ftext(paste0(row$nr, ". ", row$text), fp_normal)))
|
||||
}
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext(ADHS_FUNKTIONSNIVEAU_DISCLAIMER, fp_disclaimer)))
|
||||
|
||||
doc
|
||||
}
|
||||
|
||||
|
||||
# Server ####
|
||||
|
||||
server = function(input, output, session) {
|
||||
|
||||
observe({
|
||||
query = parseQueryString(session$clientData$url_search)
|
||||
if (!is.null(query$pseudonym) && nchar(trimws(query$pseudonym)) > 0) {
|
||||
updateTextInput(session, "pseudonym", value = trimws(query$pseudonym))
|
||||
}
|
||||
})
|
||||
|
||||
observe({
|
||||
query = parseQueryString(session$clientData$url_search)
|
||||
if (!is.null(query$chiffre) && nchar(trimws(query$chiffre)) > 0) {
|
||||
updateTextInput(session, "chiffre", value = toupper(trimws(query$chiffre)))
|
||||
}
|
||||
})
|
||||
|
||||
# Skripte werden NICHT beim App-Start gesourct, nur beim Klick.
|
||||
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 = "Ungueltige 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)))
|
||||
|
||||
if (!exists("daten_adhs_funktionsniveau", envir = .GlobalEnv))
|
||||
return(list(error = paste0(
|
||||
"Objekt 'daten_adhs_funktionsniveau' nach dem Sourcen nicht gefunden. ",
|
||||
"Bitte Download-Skript pruefen.")))
|
||||
|
||||
daten = get("daten_adhs_funktionsniveau", envir = .GlobalEnv)
|
||||
|
||||
# UNVERIFIZIERTE ANNAHME (siehe Abschnitt 4, Punkt 3 der Spezifikation): Name der
|
||||
# Session-Spalte. Vor dem ersten Produktiveinsatz mit einem echten Testdurchlauf pruefen.
|
||||
if (!("session" %in% names(daten)))
|
||||
return(list(error = "Erwartete Spalte 'session' nicht in den Daten gefunden - Datenexport pruefen."))
|
||||
|
||||
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("pseudo", envir = .GlobalEnv))
|
||||
return(list(error = paste0(
|
||||
"Objekt 'pseudo' nach dem Sourcen nicht gefunden. Bitte Pseudonym-Skript pruefen.")))
|
||||
|
||||
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]))
|
||||
}
|
||||
|
||||
if (nchar(chiffre) == 0)
|
||||
return(list(error = "Pseudonym in der 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)
|
||||
|
||||
treffer_dat = daten[daten$session %in% alle_session_ids, ]
|
||||
if (nrow(treffer_dat) == 0)
|
||||
return(list(error = paste0(
|
||||
"Kein adhs_funktionsniveau-Datensatz fuer Chiffre '", chiffre, "' gefunden. (",
|
||||
length(alle_session_ids), " Pseudonym(e) geprueft)")))
|
||||
|
||||
info_mehrere = NULL
|
||||
if (nrow(treffer_dat) > 1) {
|
||||
n = nrow(treffer_dat)
|
||||
if ("created" %in% names(treffer_dat)) {
|
||||
treffer_dat = treffer_dat[order(treffer_dat$created, decreasing = TRUE), ]
|
||||
}
|
||||
info_mehrere = paste0(
|
||||
"Mehrere Ausfuellungen gefunden (", n, " Eintraege). Angezeigt wird die neueste."
|
||||
)
|
||||
treffer_dat = treffer_dat[1, , drop = FALSE]
|
||||
}
|
||||
|
||||
zeile = treffer_dat[1, , drop = FALSE]
|
||||
|
||||
# UNVERIFIZIERTE ANNAHME (siehe Abschnitt 4, Punkt 4 der Spezifikation): Quelle und
|
||||
# Format des Ausfuelldatums (Spalte 'created'). Vor dem ersten Produktiveinsatz mit
|
||||
# einem echten Testdurchlauf gegenpruefen.
|
||||
ausfuelldatum_hinweis = NULL
|
||||
datum_wert = if ("created" %in% names(zeile)) zeile[["created"]][1] else NA
|
||||
datum_obj = tryCatch({
|
||||
if (is.character(datum_wert)) as.Date(as.POSIXct(datum_wert)) else as.Date(datum_wert)
|
||||
}, error = function(e) NA)
|
||||
if (is.null(datum_obj) || length(datum_obj) == 0 || is.na(datum_obj)) {
|
||||
datum_obj = Sys.Date()
|
||||
ausfuelldatum_hinweis = "Ausfuelldatum aus den Daten nicht bestimmbar, Downloaddatum verwendet."
|
||||
}
|
||||
datum_str = format(datum_obj, "%d.%m.%Y")
|
||||
|
||||
profil = berechne_funktionsniveau_profil(zeile)
|
||||
zusatz = extrahiere_zusatzfragen(zeile)
|
||||
|
||||
list(
|
||||
error = NULL,
|
||||
chiffre = chiffre,
|
||||
datum_str = datum_str,
|
||||
datum_obj = datum_obj,
|
||||
info_mehrere = info_mehrere,
|
||||
ausfuelldatum_hinweis = ausfuelldatum_hinweis,
|
||||
kategorien = profil$kategorien,
|
||||
kat10 = profil$kat10,
|
||||
kat09_texte = profil$kat09_texte,
|
||||
zusatzfragen = zusatz
|
||||
)
|
||||
})
|
||||
|
||||
output$fehler_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (!is.null(d$error)) div(class = "alert-fehler", d$error)
|
||||
})
|
||||
|
||||
output$warnung_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (!is.null(d$error)) return(NULL)
|
||||
tagList(
|
||||
if (!is.null(d$info_mehrere)) div(class = "alert-warnung", d$info_mehrere),
|
||||
if (!is.null(d$ausfuelldatum_hinweis)) div(class = "alert-warnung", d$ausfuelldatum_hinweis)
|
||||
)
|
||||
})
|
||||
|
||||
output$ergebnis_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (!is.null(d$error)) return(NULL)
|
||||
|
||||
df_profil = kategorien_zu_df(d$kategorien)
|
||||
|
||||
ungueltig_hinweise = lapply(d$kategorien, function(k) {
|
||||
if (k$n_ungueltig > 0) {
|
||||
div(class = "kat-ungueltig-hinweis",
|
||||
paste0(k$label, ": ", k$n_ungueltig, " Item(e) nicht auswertbar, nicht in der Summe beruecksichtigt."))
|
||||
}
|
||||
})
|
||||
|
||||
kat10_ui = if (d$kat10$status == "ok") {
|
||||
plotOutput("kat10_plot", height = "90px")
|
||||
} else if (d$kat10$status == "ungueltig") {
|
||||
div(class = "alert-warnung", "Kategorie 10 (Allgemeine Funktionsfaehigkeit): Wert nicht auswertbar.")
|
||||
} else {
|
||||
div(class = "alert-warnung", "Kategorie 10 (Allgemeine Funktionsfaehigkeit): nicht beantwortet.")
|
||||
}
|
||||
|
||||
kat09_ui = if (!is.na(d$kat09_texte$a) || !is.na(d$kat09_texte$b)) {
|
||||
tagList(
|
||||
tags$h5("Freitext zu Kategorie 9 (Sonstiges)"),
|
||||
if (!is.na(d$kat09_texte$a))
|
||||
div(class = "item-zeile", div(class = "item-nr", "a."), div(class = "item-text", d$kat09_texte$a)),
|
||||
if (!is.na(d$kat09_texte$b))
|
||||
div(class = "item-zeile", div(class = "item-nr", "b."), div(class = "item-text", d$kat09_texte$b))
|
||||
)
|
||||
}
|
||||
|
||||
zusatz_ui = if (nrow(d$zusatzfragen) == 0) {
|
||||
div(class = "alert-warnung", "Keine Zusatzfragen angekreuzt.")
|
||||
} else {
|
||||
lapply(seq_len(nrow(d$zusatzfragen)), function(i) {
|
||||
row = d$zusatzfragen[i, ]
|
||||
div(class = "item-zeile",
|
||||
div(class = "item-nr", paste0(row$nr, ".")),
|
||||
div(class = "item-text", row$text)
|
||||
)
|
||||
})
|
||||
}
|
||||
|
||||
tagList(
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "ADHS-Funktionsniveau"),
|
||||
|
||||
div(class = "meta-block",
|
||||
tags$strong("Chiffre: "), d$chiffre,
|
||||
tags$span(" | ", style = "color:#ccc;"),
|
||||
tags$strong("Ausfuelldatum: "), d$datum_str
|
||||
),
|
||||
|
||||
div(class = "richtungs-hinweis", ADHS_FUNKTIONSNIVEAU_RICHTUNGSHINWEIS),
|
||||
|
||||
tags$hr(),
|
||||
|
||||
tags$h5("Funktionsniveau-Profil (Kategorien 1-9)"),
|
||||
if (!is.null(df_profil))
|
||||
plotOutput("profil_plot", height = paste0(max(200, nrow(df_profil) * 38), "px"))
|
||||
else
|
||||
div(class = "alert-warnung", "Keine Kategorie konnte berechnet werden (keine gueltigen Werte)."),
|
||||
ungueltig_hinweise,
|
||||
|
||||
tags$hr(),
|
||||
|
||||
tags$h5("Kategorie 10: Allgemeine Funktionsfaehigkeit"),
|
||||
kat10_ui,
|
||||
|
||||
if (!is.null(kat09_ui)) tagList(tags$hr(), kat09_ui)
|
||||
),
|
||||
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "Zusatzfragen (Teil 2, ohne Score)"),
|
||||
div(zusatz_ui)
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
output$profil_plot = renderPlot({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
req(is.null(d$error))
|
||||
df = kategorien_zu_df(d$kategorien)
|
||||
req(!is.null(df))
|
||||
make_profil_plot(df)
|
||||
}, bg = "transparent")
|
||||
|
||||
output$kat10_plot = renderPlot({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
req(is.null(d$error))
|
||||
req(d$kat10$status == "ok")
|
||||
make_kat10_plot(d$kat10$wert)
|
||||
}, bg = "transparent")
|
||||
|
||||
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.null(d$datum_obj))
|
||||
format(d$datum_obj, "%Y%m%d") else format(Sys.Date(), "%Y%m%d")
|
||||
paste0("adhs_funktionsniveau_", 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_adhs_funktionsniveau_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