Initial commit
This commit is contained in:
commit
3cba772836
1341 changed files with 532924 additions and 0 deletions
BIN
FKG/.RData
Normal file
BIN
FKG/.RData
Normal file
Binary file not shown.
1
FKG/.Rprofile
Normal file
1
FKG/.Rprofile
Normal file
|
|
@ -0,0 +1 @@
|
|||
source("renv/activate.R")
|
||||
13
FKG/FKG.Rproj
Normal file
13
FKG/FKG.Rproj
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
Version: 1.0
|
||||
|
||||
RestoreWorkspace: Default
|
||||
SaveWorkspace: Default
|
||||
AlwaysSaveHistory: Default
|
||||
|
||||
EnableCodeIndexing: Yes
|
||||
UseSpacesForTab: Yes
|
||||
NumSpacesForTab: 2
|
||||
Encoding: UTF-8
|
||||
|
||||
RnwWeave: Sweave
|
||||
LaTeX: pdfLaTeX
|
||||
532
FKG/app.R
Normal file
532
FKG/app.R
Normal file
|
|
@ -0,0 +1,532 @@
|
|||
# Präambel ####
|
||||
|
||||
FKG_DISCLAIMER = paste0(
|
||||
"Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
|
||||
"keine klinische Diagnose. Fuer den FKG liegt keine validierte Berechnungsvorschrift, ",
|
||||
"kein Cutoff und keine Normstichprobe vor. Die dargestellten Zahlen sind rein deskriptive ",
|
||||
"Zaehlungen, keine psychometrischen Kennwerte. Die Interpretation obliegt der ",
|
||||
"behandelnden Person."
|
||||
)
|
||||
|
||||
library(shiny)
|
||||
library(dplyr)
|
||||
library(haven)
|
||||
library(officer)
|
||||
|
||||
|
||||
# Infrastruktur ####
|
||||
|
||||
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_fkg.R" # liefert beim Sourcen: daten_fkg
|
||||
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R" # liefert beim Sourcen: pseudo
|
||||
AKZENT_FARBE = "#8B2635"
|
||||
|
||||
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 ####
|
||||
|
||||
# Nie hartkodiert 1/2 - choice1 = "Ja" ist bei fkg.xlsx (mc_button) umgekehrt zur
|
||||
# sonstigen Konvention, daher immer ueber das labels-Attribut der Original-Spalte aufloesen.
|
||||
fkg_get_antwort = function(original_col, wert) {
|
||||
if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) return(NA_character_)
|
||||
lbl_attr = attr(original_col, "labels")
|
||||
if (!is.null(lbl_attr) && length(lbl_attr) > 0) {
|
||||
pos = which(as.vector(lbl_attr) == as.numeric(wert[1]))
|
||||
if (length(pos) > 0) return(names(lbl_attr)[pos[1]])
|
||||
}
|
||||
NA_character_
|
||||
}
|
||||
|
||||
# Entfernt Markdown-Escapes ("1\. Text" -> "1. Text", so liegt das label-Attribut
|
||||
# in der fkg.xlsx vor) und danach die fuehrende Itemnummer samt Trennzeichen.
|
||||
fkg_clean_item_text = function(text) {
|
||||
if (is.null(text) || length(text) == 0 || is.na(text[1])) return(NA_character_)
|
||||
txt = gsub("\\.", ".", trimws(as.character(text[1])), fixed = TRUE)
|
||||
trimws(sub("^[0-9.): ]+", "", txt))
|
||||
}
|
||||
|
||||
# Baut die Item-Tabelle einer einzelnen Auswertung: Text + Antwort je Item, gejoint
|
||||
# mit der statischen Faktor-Zuordnung, sortiert Ja vor Nein (stabil je Faktor).
|
||||
fkg_erstelle_item_tabelle = function(zeile, daten) {
|
||||
items = fkg_mapping$item
|
||||
|
||||
antworten = vapply(items, function(it) {
|
||||
fkg_get_antwort(daten[[it]], zeile[[it]])
|
||||
}, character(1))
|
||||
|
||||
texte = vapply(items, function(it) {
|
||||
fkg_clean_item_text(attr(daten[[it]], "label"))
|
||||
}, character(1))
|
||||
|
||||
tab = data.frame(
|
||||
item = items,
|
||||
item_nr = as.integer(sub("^fkg_", "", items)),
|
||||
faktor = fkg_mapping$faktor,
|
||||
item_text = texte,
|
||||
antwort = antworten,
|
||||
ist_ja = !is.na(antworten) & toupper(trimws(antworten)) == "JA",
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
arrange(tab, faktor, desc(ist_ja))
|
||||
}
|
||||
|
||||
# Teilt die sortierte Item-Tabelle in die Abschnitte 1-5 + "Nicht zugeordnet",
|
||||
# je mit der rein deskriptiven "X von Y"-Zaehlung.
|
||||
fkg_gruppiere = function(tab) {
|
||||
lapply(FKG_FAKTOR_REIHENFOLGE, function(fname) {
|
||||
sub_tab = tab[tab$faktor == fname, ]
|
||||
list(
|
||||
faktor = fname,
|
||||
items = sub_tab,
|
||||
anzahl_ja = sum(sub_tab$ist_ja),
|
||||
gesamt = nrow(sub_tab)
|
||||
)
|
||||
})
|
||||
}
|
||||
|
||||
|
||||
# Datenaufbereitung ####
|
||||
|
||||
FKG_FAKTOR_REIHENFOLGE = c(
|
||||
"Faktor 1: Katastrophisierende Bewertung",
|
||||
"Faktor 2: Intoleranz von körperlichen Beschwerden",
|
||||
"Faktor 3: Körperliche Schwäche",
|
||||
"Faktor 4: Vegetative Missempfindungen",
|
||||
"Faktor 5: Gesundheitsverhalten",
|
||||
"Nicht zugeordnet"
|
||||
)
|
||||
|
||||
fkg_faktor_items = list(
|
||||
"Faktor 1: Katastrophisierende Bewertung" = c(
|
||||
"fkg_05", "fkg_06", "fkg_08", "fkg_09", "fkg_10", "fkg_11", "fkg_15", "fkg_16", "fkg_20", "fkg_24",
|
||||
"fkg_27", "fkg_28", "fkg_33", "fkg_35", "fkg_38", "fkg_39", "fkg_45", "fkg_47", "fkg_49", "fkg_55"
|
||||
),
|
||||
"Faktor 2: Intoleranz von körperlichen Beschwerden" = c(
|
||||
"fkg_01", "fkg_02", "fkg_14", "fkg_30", "fkg_32", "fkg_41", "fkg_61"
|
||||
),
|
||||
"Faktor 3: Körperliche Schwäche" = c(
|
||||
"fkg_03", "fkg_07", "fkg_18", "fkg_23", "fkg_31", "fkg_43", "fkg_48", "fkg_65", "fkg_67"
|
||||
),
|
||||
"Faktor 4: Vegetative Missempfindungen" = c(
|
||||
"fkg_25", "fkg_42", "fkg_44", "fkg_59", "fkg_60", "fkg_63"
|
||||
),
|
||||
"Faktor 5: Gesundheitsverhalten" = c(
|
||||
"fkg_21", "fkg_34", "fkg_51", "fkg_52"
|
||||
),
|
||||
"Nicht zugeordnet" = c(
|
||||
"fkg_04", "fkg_12", "fkg_13", "fkg_17", "fkg_19", "fkg_22", "fkg_26", "fkg_29", "fkg_36", "fkg_37", "fkg_40",
|
||||
"fkg_46", "fkg_50", "fkg_53", "fkg_54", "fkg_56", "fkg_57", "fkg_58", "fkg_62", "fkg_64", "fkg_66", "fkg_68"
|
||||
)
|
||||
)
|
||||
|
||||
fkg_mapping = bind_rows(lapply(names(fkg_faktor_items), function(fname) {
|
||||
data.frame(item = fkg_faktor_items[[fname]], faktor = fname, stringsAsFactors = FALSE)
|
||||
}))
|
||||
fkg_mapping$faktor = factor(fkg_mapping$faktor, levels = FKG_FAKTOR_REIHENFOLGE)
|
||||
|
||||
|
||||
# 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; }
|
||||
.faktor-zaehlung { color: #555; font-size: 0.9em; margin-bottom: 8px; }
|
||||
.item-zeile {
|
||||
display: flex; align-items: flex-start; gap: 10px;
|
||||
padding: 7px 0; border-bottom: 1px solid #F0F0F0;
|
||||
}
|
||||
.item-zeile.ist-ja {
|
||||
background: #FFF3E0; border-left: 4px solid #8B2635; padding-left: 8px;
|
||||
}
|
||||
.item-zeile.gruppen-trenner { margin-top: 10px; border-top: 2px solid #ddd; padding-top: 10px; }
|
||||
.item-nr { font-weight: 600; color: #8B2635; min-width: 34px; flex-shrink: 0; }
|
||||
.item-text { flex: 1; color: #333; font-size: 0.92em; }
|
||||
.antwort { font-weight: 700; min-width: 50px; text-align: right; flex-shrink: 0; font-size: 0.9em; color: #555; }
|
||||
.item-zeile.ist-ja .antwort { color: #8B2635; }
|
||||
.start-hinweis { text-align: center; color: #bbb; padding: 30px 0; font-style: italic; }
|
||||
"
|
||||
|
||||
app_css = gsub("#8B2635", AKZENT_FARBE, app_css, fixed = TRUE)
|
||||
|
||||
ui = fluidPage(
|
||||
tags$head(
|
||||
tags$meta(charset = "UTF-8"),
|
||||
tags$style(HTML(app_css))
|
||||
),
|
||||
|
||||
div(class = "app-header",
|
||||
tags$h2("FKG – Fragebogen zu Körper und Gesundheit"),
|
||||
tags$p("Hiller, Rief, Fichter u. a. 1997 | Deskriptive Itemauswertung, kein Score")
|
||||
),
|
||||
|
||||
div(class = "container-fluid",
|
||||
|
||||
div(class = "input-panel",
|
||||
div(style = "min-width: 360px; white-space: nowrap;",
|
||||
textInput("pseudonym",
|
||||
label = tagList(
|
||||
"Pseudonym",
|
||||
tags$span(style = "font-weight: normal; font-style: italic; font-size: 0.78em; color: #888; margin-left: 4px; white-space: nowrap;",
|
||||
"optional, hat Vorrang vor Chiffre")
|
||||
),
|
||||
placeholder = "optional", width = "340px")
|
||||
),
|
||||
div(style = "min-width: 200px;",
|
||||
textInput("chiffre", label = "Patientenchiffre",
|
||||
placeholder = "z.B. P000123", width = "100%")
|
||||
),
|
||||
actionButton("btn_suchen", "Auswerten", class = "btn btn-primary btn-laden"),
|
||||
div(style = "margin-left: auto;",
|
||||
downloadButton("download_word", "Word-Export (.docx)")
|
||||
)
|
||||
),
|
||||
|
||||
uiOutput("ergebnis_ui")
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
# Word-Export ####
|
||||
|
||||
erstelle_fkg_docx = function(erg) {
|
||||
doc = read_docx()
|
||||
|
||||
fp_titel = fp_text(color = AKZENT_FARBE, bold = TRUE, font.size = 18)
|
||||
fp_label = fp_text(bold = TRUE, font.size = 11)
|
||||
fp_normal = fp_text(font.size = 11)
|
||||
fp_warnung = fp_text(font.size = 9.5, italic = TRUE, color = "#8a6d00")
|
||||
fp_faktor = fp_text(color = AKZENT_FARBE, bold = TRUE, font.size = 13)
|
||||
fp_zaehlung = fp_text(font.size = 10, italic = TRUE, color = "#555555")
|
||||
fp_item_nr = fp_text(bold = TRUE, font.size = 10, color = "#555555")
|
||||
fp_item_text = fp_text(font.size = 10)
|
||||
fp_item_ja = fp_text(font.size = 10, bold = TRUE, shading.color = "#FFE9CC")
|
||||
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("FKG - Einzelauswertung", fp_titel)))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Chiffre: ", fp_label),
|
||||
ftext(erg$chiffre, fp_normal),
|
||||
ftext(" Ausfülldatum: ", fp_label),
|
||||
ftext(erg$datum_str, fp_normal)
|
||||
))
|
||||
if (!is.null(erg$warnung_daten)) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(erg$warnung_daten, fp_warnung)))
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
for (g in erg$gruppen) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(g$faktor, fp_faktor)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
paste0(g$anzahl_ja, " von ", g$gesamt, " Aussagen zutreffend"), fp_zaehlung)))
|
||||
|
||||
if (nrow(g$items) > 0) {
|
||||
for (i in seq_len(nrow(g$items))) {
|
||||
row = g$items[i, ]
|
||||
item_text = if (!is.na(row$item_text)) row$item_text else row$item
|
||||
antwort_text = if (!is.na(row$antwort)) row$antwort else "k. A."
|
||||
fp_zeile = if (isTRUE(row$ist_ja)) fp_item_ja else fp_item_text
|
||||
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(sprintf("%02d", row$item_nr), ". "), fp_item_nr),
|
||||
ftext(paste0(item_text, " – "), fp_zeile),
|
||||
ftext(antwort_text, fp_zeile)
|
||||
))
|
||||
}
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
}
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext(FKG_DISCLAIMER, fp_disclaimer)))
|
||||
|
||||
doc
|
||||
}
|
||||
|
||||
|
||||
# Server ####
|
||||
|
||||
server = function(input, output, session) {
|
||||
|
||||
observe({
|
||||
query = parseQueryString(session$clientData$url_search)
|
||||
if (!is.null(query$pseudonym) && nchar(trimws(query$pseudonym)) > 0) {
|
||||
updateTextInput(session, "pseudonym", value = trimws(query$pseudonym))
|
||||
}
|
||||
})
|
||||
|
||||
observe({
|
||||
query = parseQueryString(session$clientData$url_search)
|
||||
if (!is.null(query$chiffre) && nchar(trimws(query$chiffre)) > 0) {
|
||||
updateTextInput(session, "chiffre", value = toupper(trimws(query$chiffre)))
|
||||
}
|
||||
})
|
||||
|
||||
ergebnis_r = eventReactive(input$btn_suchen, {
|
||||
|
||||
chiffre = toupper(trimws(input$chiffre))
|
||||
|
||||
if (nchar(trimws(input$pseudonym)) == 0 && nchar(chiffre) == 0) {
|
||||
return(list(typ = "leere_eingabe", meldung = "Bitte Chiffre oder Pseudonym eingeben."))
|
||||
}
|
||||
if (nchar(trimws(input$pseudonym)) == 0 && !grepl("^[A-Z][0-9]{6}$", chiffre)) {
|
||||
return(list(typ = "format_fehler", chiffre = chiffre))
|
||||
}
|
||||
|
||||
if (!file.exists(PFAD_DOWNLOAD_SKRIPT)) {
|
||||
return(list(typ = "skript_fehler",
|
||||
meldung = paste0("Download-Skript nicht gefunden: ", PFAD_DOWNLOAD_SKRIPT)))
|
||||
}
|
||||
if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) {
|
||||
return(list(typ = "skript_fehler",
|
||||
meldung = paste0("Pseudonym-Skript nicht gefunden: ", PFAD_PSEUDONYM_SKRIPT)))
|
||||
}
|
||||
|
||||
ok = tryCatch({
|
||||
source(PFAD_DOWNLOAD_SKRIPT, local = FALSE)
|
||||
list(ok = TRUE)
|
||||
}, error = function(e) list(ok = FALSE, msg = e$message))
|
||||
if (!ok$ok) return(list(typ = "skript_fehler", meldung = ok$msg))
|
||||
|
||||
db_ordner = local({
|
||||
ordner = dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE))
|
||||
gefunden = NULL
|
||||
for (i in 1:5) {
|
||||
if (file.exists(file.path(ordner, "pseudonyme.db"))) {
|
||||
gefunden = ordner
|
||||
break
|
||||
}
|
||||
elternteil = dirname(ordner)
|
||||
if (elternteil == ordner) break
|
||||
ordner = elternteil
|
||||
}
|
||||
gefunden
|
||||
})
|
||||
if (is.null(db_ordner)) {
|
||||
return(list(typ = "skript_fehler",
|
||||
meldung = "pseudonyme.db wurde ausgehend vom Pseudonym-Skript-Ordner bis zu 5 Ebenen nach oben nicht gefunden."))
|
||||
}
|
||||
|
||||
alter_wd = getwd()
|
||||
on.exit(setwd(alter_wd), add = TRUE)
|
||||
setwd(db_ordner)
|
||||
|
||||
ok_ps = tryCatch({
|
||||
source(PFAD_PSEUDONYM_SKRIPT, local = FALSE)
|
||||
list(ok = TRUE)
|
||||
}, error = function(e) list(ok = FALSE, msg = e$message))
|
||||
if (!ok_ps$ok) return(list(typ = "skript_fehler", meldung = ok_ps$msg))
|
||||
|
||||
if (!exists("daten_fkg", envir = .GlobalEnv)) {
|
||||
return(list(typ = "skript_fehler",
|
||||
meldung = "Objekt 'daten_fkg' wurde nach dem Sourcen des Download-Skripts nicht gefunden."))
|
||||
}
|
||||
if (!exists("pseudo", envir = .GlobalEnv)) {
|
||||
return(list(typ = "skript_fehler",
|
||||
meldung = "Objekt 'pseudo' wurde nach dem Sourcen des Pseudonym-Skripts nicht gefunden."))
|
||||
}
|
||||
|
||||
daten_fkg = get("daten_fkg", envir = .GlobalEnv)
|
||||
pseudo = get("pseudo", envir = .GlobalEnv)
|
||||
|
||||
if (nchar(trimws(input$pseudonym)) > 0) {
|
||||
pw_treffer = pseudo[pseudo$pseudonym == trimws(input$pseudonym), ]
|
||||
if (nrow(pw_treffer) > 0) chiffre = toupper(trimws(pw_treffer$chiffre[1]))
|
||||
}
|
||||
|
||||
treffer_ps = pseudo[pseudo$chiffre == chiffre, ]
|
||||
if (nrow(treffer_ps) == 0) {
|
||||
return(list(typ = "chiffre_nicht_gefunden", chiffre = chiffre))
|
||||
}
|
||||
|
||||
alle_session_ids = unique(treffer_ps$pseudonym)
|
||||
if (nchar(trimws(input$pseudonym)) > 0) alle_session_ids = trimws(input$pseudonym)
|
||||
|
||||
treffer_dat = daten_fkg[daten_fkg$session %in% alle_session_ids, ]
|
||||
if (nrow(treffer_dat) == 0) {
|
||||
return(list(typ = "session_nicht_gefunden", chiffre = chiffre))
|
||||
}
|
||||
|
||||
warnung_daten = NULL
|
||||
if (nrow(treffer_dat) > 1) {
|
||||
n = nrow(treffer_dat)
|
||||
treffer_dat = treffer_dat[order(treffer_dat$created, decreasing = TRUE), ]
|
||||
datum_neu = tryCatch(
|
||||
format(as.POSIXct(treffer_dat$created[1]), "%d.%m.%Y %H:%M"),
|
||||
error = function(e) "unbekanntes Datum"
|
||||
)
|
||||
warnung_daten = paste0(
|
||||
"Mehrere 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")
|
||||
)
|
||||
|
||||
tab = fkg_erstelle_item_tabelle(zeile, daten_fkg)
|
||||
gruppen = fkg_gruppiere(tab)
|
||||
|
||||
list(
|
||||
typ = "ergebnis",
|
||||
chiffre = chiffre,
|
||||
datum_str = datum_str,
|
||||
warnung_daten = warnung_daten,
|
||||
tab = tab,
|
||||
gruppen = gruppen
|
||||
)
|
||||
})
|
||||
|
||||
output$ergebnis_ui = renderUI({
|
||||
|
||||
if (input$btn_suchen == 0) {
|
||||
return(div(class = "abschnitt-karte start-hinweis",
|
||||
"Bitte Chiffre oder Pseudonym eingeben und auf „Auswerten“ klicken."
|
||||
))
|
||||
}
|
||||
|
||||
erg = ergebnis_r()
|
||||
|
||||
if (erg$typ == "leere_eingabe") {
|
||||
return(div(class = "alert-warnung", erg$meldung))
|
||||
}
|
||||
if (erg$typ == "format_fehler") {
|
||||
return(div(class = "alert-warnung",
|
||||
paste0("Ungültige Chiffre „", erg$chiffre, "“. Erwartet: ein Großbuchstabe gefolgt von 6 Ziffern (z. B. P000123).")))
|
||||
}
|
||||
if (erg$typ == "skript_fehler") {
|
||||
return(div(class = "alert-fehler", tags$pre(style = "white-space:pre-wrap; margin:0;", erg$meldung)))
|
||||
}
|
||||
if (erg$typ == "chiffre_nicht_gefunden") {
|
||||
return(div(class = "alert-fehler",
|
||||
paste0("Chiffre „", erg$chiffre, "“ wurde in der Pseudonym-Datenbank nicht gefunden.")))
|
||||
}
|
||||
if (erg$typ == "session_nicht_gefunden") {
|
||||
return(div(class = "alert-fehler",
|
||||
paste0("Kein FKG-Datensatz für Chiffre „", erg$chiffre, "“ gefunden.")))
|
||||
}
|
||||
|
||||
meta_block = div(class = "meta-block",
|
||||
tags$strong("Chiffre: "), erg$chiffre, " ",
|
||||
tags$strong("Ausfülldatum: "), erg$datum_str
|
||||
)
|
||||
|
||||
kopf_karte = div(class = "abschnitt-karte",
|
||||
meta_block,
|
||||
if (!is.null(erg$warnung_daten)) div(class = "alert-warnung", erg$warnung_daten) else NULL
|
||||
)
|
||||
|
||||
faktor_karten = lapply(erg$gruppen, function(g) {
|
||||
|
||||
items_ui = lapply(seq_len(nrow(g$items)), function(i) {
|
||||
row = g$items[i, ]
|
||||
uebergang = i > 1 && isTRUE(g$items$ist_ja[i - 1]) && !isTRUE(row$ist_ja)
|
||||
klasse = paste0(
|
||||
"item-zeile",
|
||||
if (isTRUE(row$ist_ja)) " ist-ja" else "",
|
||||
if (uebergang) " gruppen-trenner" else ""
|
||||
)
|
||||
div(class = klasse,
|
||||
div(class = "item-nr", paste0(sprintf("%02d", row$item_nr), ".")),
|
||||
div(class = "item-text", if (!is.na(row$item_text)) row$item_text else row$item),
|
||||
span(class = "antwort", if (!is.na(row$antwort)) row$antwort else "k. A.")
|
||||
)
|
||||
})
|
||||
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", g$faktor),
|
||||
div(class = "faktor-zaehlung",
|
||||
paste0(g$anzahl_ja, " von ", g$gesamt, " Aussagen zutreffend")),
|
||||
div(items_ui)
|
||||
)
|
||||
})
|
||||
|
||||
tagList(kopf_karte, faktor_karten)
|
||||
})
|
||||
|
||||
output$download_word = downloadHandler(
|
||||
filename = function() {
|
||||
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
if (is.null(erg) || erg$typ != "ergebnis") return("FKG_Export.docx")
|
||||
chiffre_esc = gsub("[^A-Za-z0-9_-]", "_", erg$chiffre)
|
||||
ausfuelldatum_fn = tryCatch(
|
||||
format(as.Date(erg$datum_str, "%d.%m.%Y"), "%Y%m%d"),
|
||||
error = function(e) format(Sys.Date(), "%Y%m%d")
|
||||
)
|
||||
paste0("FKG_", chiffre_esc, "_", ausfuelldatum_fn, ".docx")
|
||||
},
|
||||
content = function(file) {
|
||||
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
if (is.null(erg) || erg$typ != "ergebnis") {
|
||||
doc = read_docx()
|
||||
doc = body_add_par(doc,
|
||||
"Kein Datensatz geladen. Bitte zuerst Chiffre oder Pseudonym eingeben und 'Auswerten' klicken.",
|
||||
style = "Normal")
|
||||
print(doc, target = file)
|
||||
return()
|
||||
}
|
||||
doc = tryCatch(
|
||||
erstelle_fkg_docx(erg),
|
||||
error = function(e) {
|
||||
err_doc = read_docx()
|
||||
body_add_par(err_doc,
|
||||
paste0("Fehler beim Erstellen des Word-Dokuments: ", e$message),
|
||||
style = "Normal")
|
||||
}
|
||||
)
|
||||
print(doc, target = file)
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
# Start ####
|
||||
|
||||
shinyApp(ui, server)
|
||||
2552
FKG/renv.lock
Normal file
2552
FKG/renv.lock
Normal file
File diff suppressed because it is too large
Load diff
14
FKG/setup_renv.R
Normal file
14
FKG/setup_renv.R
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
# Einmalig ausfuehren, bevor die App zum ersten Mal gestartet wird.
|
||||
# Initialisiert renv und installiert alle benoedigten Pakete.
|
||||
#
|
||||
# DBI und RSQLite werden vom gesourcten Pseudonym-Skript benoetigt,
|
||||
# nicht direkt von der App selbst.
|
||||
|
||||
renv::init()
|
||||
|
||||
pkgs <- c("shiny", "dplyr", "ggplot2", "haven", "officer", "DBI", "RSQLite", "formr")
|
||||
install.packages(pkgs)
|
||||
|
||||
renv::snapshot()
|
||||
|
||||
message("Setup abgeschlossen. App starten mit: shiny::runApp()")
|
||||
Loading…
Add table
Add a link
Reference in a new issue