# Präambel #### PFAD_DOWNLOAD_SKRIPT = "../API/get_data_mki30.R" PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R" AKZENT_FARBE = "#8B2635" MKF30_DISCLAIMER = paste0( "Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ", "keine klinische Diagnose. Die Interpretation obliegt der behandelnden Person. ", "Fuer den MKF-30 existieren keine etablierten klinischen Cutoffs; die angegebenen ", "Referenzwerte dienen ausschliesslich der groben Einordnung." ) # Rein deskriptive Farbverlauf-Kodierung der 4 Antwortstufen (1-4) auf den # Item-Badges - keine Klassifikation, nur visuelle Abstufung der Zustimmung. MKF30_BADGE_FARBEN = c( "1" = "#4CAF50", "2" = "#F48FB1", "3" = "#EF5350", "4" = "#B71C1C" ) MKF30_BADGE_TEXT_FARBEN = c( "1" = "white", "2" = "#333333", "3" = "white", "4" = "white" ) 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 #### # Entfernt formr-Nummerierungsartefakte am Anfang des Itemtexts # (z.B. "16. ", "01) " oder markdown-escaped "16\. "), die im label-Attribut erscheinen. # Hinweis: [.)\s] wuerde in R's Standard-Regex-Engine \ und s als literale Zeichen # matchen statt \s als Whitespace-Kuerzel - deshalb Escaping zuerst separat aufloesen. clean_item_label = function(text) { if (is.null(text) || length(text) == 0 || is.na(text[1])) return(NA_character_) txt = trimws(as.character(text[1])) txt = sub("^(\\d+)\\\\([.)])", "\\1\\2", txt) txt = sub("^\\d+[.)]\\s*", "", txt) trimws(txt) } # Robustes Recoding: zuerst ueber das labels-Attribut der Originalspalte # (Choice-Text -> Zahl laut MKF30_ANTWORT_TEXTE), sonst ueber einen bereits # 1-basierten numerischen Index (Skala beginnt bei 1, keine Verschiebung). # formr-Exportverhalten fuer mc-Items mit 4 Choices ist nicht live verifiziert, # daher beide Faelle abdecken und sonst NA setzen (nicht stillschweigend 0/Default). mkf30_recode_wert = function(original_col, wert) { if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) return(NA_real_) wert1 = wert[1] lbl_attr = attr(original_col, "labels") text_wert = NA_character_ if (!is.null(lbl_attr) && length(lbl_attr) > 0) { pos = which(as.vector(lbl_attr) == suppressWarnings(as.numeric(wert1))) if (length(pos) > 0) text_wert = names(lbl_attr)[pos[1]] } else if (is.character(wert1)) { text_wert = wert1 } else if (is.factor(wert1)) { text_wert = as.character(wert1) } if (!is.na(text_wert)) { text_norm = tolower(trimws(text_wert)) bekannte_norm = tolower(trimws(names(MKF30_ANTWORT_TEXTE))) treffer = which(bekannte_norm == text_norm) if (length(treffer) > 0) return(as.numeric(MKF30_ANTWORT_TEXTE[[treffer[1]]])) } num_wert = suppressWarnings(as.numeric(wert1)) if (!is.na(num_wert) && num_wert >= 1 && num_wert <= 4) return(num_wert) NA_real_ } mkf30_item_text = function(original_col, spalte_name) { lbl = attr(original_col, "label") txt = clean_item_label(lbl) if (is.na(txt) || nchar(txt) == 0) return(spalte_name) txt } mkf30_antwort_label = function(wert) { if (is.na(wert)) return("nicht auswertbar") paste0(wert, " - ", MKF30_ANTWORT_LABELS[[as.character(wert)]]) } # Items eines Faktors absteigend nach Wert sortiert (4 zuerst, 1 zuletzt), # bei Gleichstand Original-Itemnummer als Tie-Breaker. Reine Anzeigelogik, # hat keinen Einfluss auf die Summenbildung. mkf30_item_block_sortiert = function(items_df, faktor_code) { block = items_df[items_df$faktor == faktor_code, ] block[order(-block$wert, block$nummer), ] } # Berechnet Faktorsummenwerte und Item-Einzelwerte fuer einen Datensatz (eine Zeile). berechne_mkf30 = function(daten, zeile) { spalten = mkf30_item_spalten(daten) if (length(spalten) == 0) { stop("Keine MKF-30-Item-Spalten (mkf30_NN_fX) in den Daten gefunden.") } item_nummern = mkf30_spalte_nummer(spalten) item_faktoren = mkf30_spalte_faktor(spalten) item_werte = sapply(spalten, function(sp) mkf30_recode_wert(daten[[sp]], zeile[[sp]])) item_texte = sapply(spalten, function(sp) mkf30_item_text(daten[[sp]], sp)) items_df = data.frame( spalte = spalten, nummer = item_nummern, faktor = item_faktoren, text = item_texte, wert = as.numeric(item_werte), stringsAsFactors = FALSE ) faktor_codes = sort(unique(items_df$faktor)) ergebnis_tabelle = do.call(rbind, lapply(faktor_codes, function(fc) { sub_items = items_df[items_df$faktor == fc, ] wert_summe = if (any(is.na(sub_items$wert))) NA_real_ else sum(sub_items$wert) ref = MKF30_REFERENZ[MKF30_REFERENZ$faktor == fc, ] diff_sd = if (is.na(wert_summe)) NA_real_ else round((wert_summe - ref$ref_m) / ref$ref_sd, 2) data.frame( faktor_code = fc, faktor_name = MKF30_FAKTOR_NAMEN[[fc]], wert = wert_summe, ref_m = ref$ref_m, ref_sd = ref$ref_sd, diff_sd = diff_sd, stringsAsFactors = FALSE ) })) list( items_df = items_df, ergebnis_tabelle = ergebnis_tabelle, n_items_gesamt = nrow(items_df), n_fehlend = sum(is.na(items_df$wert)) ) } # Datenaufbereitung #### MKF30_FAKTOR_NAMEN = c( "1" = "Unkontrollierbarkeit und Gefährlichkeit des Sorgens", "2" = "Positive Überzeugungen", "3" = "Vertrauen in das Gedächtnis", "4" = "Kognitive Selbstaufmerksamkeit", "5" = "Bedürfnis nach Kontrolle" ) # Referenzwerte der studentischen Validierungsstichprobe (Arndt et al., 2011). # F3 und F5 haben identische M/SD-Werte - so aus der Publikation uebernommen, # kein Fehler und nicht anzugleichen. MKF30_REFERENZ = data.frame( faktor = c("1", "2", "3", "4", "5"), ref_m = c(9.56, 10.91, 9.14, 12.83, 9.14), ref_sd = c(2.96, 3.17, 2.91, 3.05, 2.91), stringsAsFactors = FALSE ) MKF30_ANTWORT_TEXTE = c( "stimme nicht zu" = 1, "stimme etwas zu" = 2, "stimme überwiegend zu" = 3, "stimme stark zu" = 4 ) MKF30_ANTWORT_LABELS = setNames(names(MKF30_ANTWORT_TEXTE), as.character(MKF30_ANTWORT_TEXTE)) # Item-zu-Faktor-Zuordnung wird per Regex aus den Spaltennamen abgeleitet # (z.B. "mkf30_02_f1"), nicht separat als Liste gepflegt. mkf30_item_spalten = function(daten) { alle = names(daten) treffer = grep("^mkf30_[0-9]{2}_f[1-5]$", alle, value = TRUE) nummern = as.integer(sub("^mkf30_([0-9]{2})_f[1-5]$", "\\1", treffer)) treffer[order(nummern)] } mkf30_spalte_nummer = function(spalte) { as.integer(sub("^mkf30_([0-9]{2})_f[1-5]$", "\\1", spalte)) } mkf30_spalte_faktor = function(spalte) { sub("^mkf30_[0-9]{2}_f([1-5])$", "\\1", spalte) } # 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; } .hinweis-text { font-size: 0.85em; color: #666; font-style: italic; margin-bottom: 12px; line-height: 1.5; } .ergebnis-tabelle { width: 100%; border-collapse: collapse; } .ergebnis-tabelle th, .ergebnis-tabelle td { padding: 8px 10px; text-align: left; border-bottom: 1px solid #eee; font-size: 0.92em; } .ergebnis-tabelle th { background: #f5f5f5; color: #333; font-weight: 600; } .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; } .item-wert { border-radius: 4px; padding: 2px 9px; font-weight: 700; font-size: 0.82em; white-space: nowrap; flex-shrink: 0; display: inline-block; } .item-wert-1 { background: #4CAF50; color: white; } .item-wert-2 { background: #F48FB1; color: #333333; } .item-wert-3 { background: #EF5350; color: white; } .item-wert-4 { background: #B71C1C; color: white; } .item-wert-na { background: #E0E0E0; color: #666; } " 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("MKF-30 - Metakognitionsfragebogen (Kurzversion)"), tags$p("Wells & Cartwright-Hatton | deutsche Kurzversion nach Arndt et al. 2011") ), 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_mkf30_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_meta = fp_text(color = AKZENT_FARBE, font.size = 11) fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777") fp_hinweis = fp_text(font.size = 9, italic = TRUE, color = "#777777") doc = body_add_fpar(doc, fpar(ftext("MKF-30 - Metakognitionsfragebogen (Kurzversion)", fp_titel))) doc = body_add_fpar(doc, fpar( ftext("Chiffre: ", fp_label), ftext(erg$chiffre, fp_meta), ftext(" Ausfuelldatum: ", fp_label), ftext(erg$datum_str, fp_meta) )) if (!is.null(erg$info_mehrere)) { doc = body_add_fpar(doc, fpar( ftext(erg$info_mehrere, fp_text(font.size = 10, italic = TRUE, color = "#555555")) )) } doc = body_add_par(doc, "", style = "Normal") doc = body_add_fpar(doc, fpar(ftext("Faktor-Ergebnisse", fp_abschnitt))) doc = body_add_fpar(doc, fpar(ftext(paste0( "Die Referenzwerte stammen aus der studentischen Validierungsstichprobe (Arndt et al., 2011) ", "und dienen ausschliesslich der groben Einordnung, nicht der klinischen Bewertung. ", "Es gibt fuer den MKF-30 keine etablierten Cutoffs." ), fp_hinweis))) tab = erg$ergebnis_tabelle tab_anzeige = data.frame( "Faktor" = paste0("F", tab$faktor_code, ": ", tab$faktor_name), "Wert" = ifelse(is.na(tab$wert), "n. b.", as.character(tab$wert)), "Referenz M" = as.character(tab$ref_m), "Referenz SD" = as.character(tab$ref_sd), "Differenz (SD)" = ifelse(is.na(tab$diff_sd), "n. b.", sprintf("%.2f", tab$diff_sd)), check.names = FALSE, stringsAsFactors = FALSE ) doc = body_add_table(doc, tab_anzeige) doc = body_add_par(doc, "", style = "Normal") doc = body_add_fpar(doc, fpar(ftext("Einzelitems nach Faktor", fp_abschnitt))) faktor_codes = sort(unique(erg$items_df$faktor)) for (fc in faktor_codes) { doc = body_add_fpar(doc, fpar(ftext( paste0("F", fc, ": ", MKF30_FAKTOR_NAMEN[[fc]]), fp_text(bold = TRUE, font.size = 11, color = AKZENT_FARBE) ))) block = mkf30_item_block_sortiert(erg$items_df, fc) for (i in seq_len(nrow(block))) { zeile_item = block[i, ] wert_key = if (!is.na(zeile_item$wert) && zeile_item$wert >= 1 && zeile_item$wert <= 4) as.character(zeile_item$wert) else NA_character_ fp_badge = if (!is.na(wert_key)) fp_text(bold = TRUE, font.size = 10, color = MKF30_BADGE_TEXT_FARBEN[[wert_key]], shading.color = MKF30_BADGE_FARBEN[[wert_key]]) else fp_text(bold = TRUE, font.size = 10, color = "#666666", shading.color = "#E0E0E0") doc = body_add_fpar(doc, fpar( ftext(paste0(zeile_item$nummer, ". ", zeile_item$text, " "), fp_normal), ftext(paste0(" ", mkf30_antwort_label(zeile_item$wert), " "), fp_badge) )) } doc = body_add_par(doc, "", style = "Normal") } if (erg$n_fehlend > 0) { doc = body_add_fpar(doc, fpar(ftext( paste0(erg$n_fehlend, " von ", erg$n_items_gesamt, " Items konnten nicht zugeordnet werden."), fp_text(bold = TRUE, font.size = 10, color = "#B71C1C") ))) doc = body_add_par(doc, "", style = "Normal") } doc = body_add_fpar(doc, fpar(ftext(MKF30_DISCLAIMER, fp_disclaimer))) doc } # Server #### server = function(input, output, session) { # --- pseudonym-support-injection v1 --- 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 auf "Auswerten". ergebnis_r = eventReactive(input$btn_suchen, { chiffre = toupper(trimws(input$chiffre)) if ((nchar(trimws(input$pseudonym)) == 0 && nchar(chiffre) == 0)) { return(list(error = "Bitte eine Patientenchiffre eingeben.")) } if (!(nchar(trimws(input$pseudonym)) > 0 || grepl("^[A-Z][0-9]{6}$", chiffre))) { return(list(error = paste0( "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))) } 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(error = paste0("Fehler im Download-Skript: ", 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 }) alter_wd = getwd() on.exit(setwd(alter_wd), add = TRUE) wd_ziel = if (!is.null(db_ordner)) db_ordner else dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE)) setwd(wd_ziel) ok_ps = tryCatch({ source(PFAD_PSEUDONYM_SKRIPT, local = FALSE) if (nchar(trimws(input$pseudonym)) > 0) { .pw_wert = trimws(input$pseudonym) .pw_tab = get("pseudo", envir = .GlobalEnv) .pw_treffer = .pw_tab[.pw_tab$pseudonym == .pw_wert, ] if (nrow(.pw_treffer) > 0) chiffre = toupper(trimws(.pw_treffer$chiffre[1])) } list(ok = TRUE) }, error = function(e) list(ok = FALSE, msg = e$message)) if (!ok_ps$ok) return(list(error = paste0("Fehler im Pseudonym-Skript: ", ok_ps$msg))) if (!exists("daten_mkf30", envir = .GlobalEnv)) { return(list(error = paste0( "Objekt 'daten_mkf30' nach dem Sourcen nicht gefunden. Bitte Download-Skript pruefen." ))) } if (!exists("pseudo", envir = .GlobalEnv)) { return(list(error = paste0( "Objekt 'pseudo' nach dem Sourcen nicht gefunden. Bitte Pseudonym-Skript pruefen." ))) } daten = get("daten_mkf30", envir = .GlobalEnv) pseudo_df = get("pseudo", envir = .GlobalEnv) treffer_ps = pseudo_df[pseudo_df$chiffre == chiffre, ] if (nrow(treffer_ps) == 0) { return(list(error = paste0( "Chiffre '", chiffre, "' wurde in der Pseudonym-Datenbank nicht gefunden." ))) } alle_session_ids = unique(treffer_ps$pseudonym) if (nchar(trimws(input$pseudonym)) > 0) alle_session_ids = trimws(input$pseudonym) treffer_dat = daten[daten$session %in% alle_session_ids, ] if (nrow(treffer_dat) == 0) { return(list(error = paste0( "Kein MKF-30-Datensatz fuer Chiffre '", chiffre, "' gefunden. (", length(alle_session_ids), " Pseudonym(e) geprueft)" ))) } info_mehrere = NULL if (nrow(treffer_dat) > 1) { n = nrow(treffer_dat) treffer_dat = treffer_dat[order(treffer_dat$created, decreasing = TRUE), ] datum_neu = tryCatch( format(as.POSIXct(treffer_dat$created[1]), "%d.%m.%Y %H:%M"), error = function(e) "unbekanntes Datum" ) info_mehrere = paste0( "Mehrere Ausfuellungen gefunden (", n, " Eintraege). ", "Angezeigt wird die neueste vom ", datum_neu, "." ) treffer_dat = treffer_dat[1, , drop = FALSE] } zeile = treffer_dat[1, , drop = FALSE] datum_str = tryCatch( format(as.POSIXct(zeile[["created"]][1]), "%d.%m.%Y"), error = function(e) format(Sys.Date(), "%d.%m.%Y") ) datum_yyyymmdd = tryCatch( format(as.POSIXct(zeile[["created"]][1]), "%Y%m%d"), error = function(e) format(Sys.Date(), "%Y%m%d") ) berechnung = tryCatch( berechne_mkf30(daten, zeile), error = function(e) list(error_intern = e$message) ) if (!is.null(berechnung$error_intern)) { return(list(error = paste0("Fehler bei der Berechnung: ", berechnung$error_intern))) } list( error = NULL, chiffre = chiffre, datum_str = datum_str, datum_yyyymmdd = datum_yyyymmdd, info_mehrere = info_mehrere, items_df = berechnung$items_df, ergebnis_tabelle = berechnung$ergebnis_tabelle, n_items_gesamt = berechnung$n_items_gesamt, n_fehlend = berechnung$n_fehlend ) }) 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 (isTRUE(d$n_fehlend > 0)) div(class = "alert-warnung", paste0( d$n_fehlend, " von ", d$n_items_gesamt, " Items konnten nicht zugeordnet werden." )) ) }) output$ergebnis_ui = renderUI({ req(input$btn_suchen) d = ergebnis_r() if (!is.null(d$error)) return(NULL) tab = d$ergebnis_tabelle tabellen_zeilen = lapply(seq_len(nrow(tab)), function(i) { z = tab[i, ] tags$tr( tags$td(paste0("F", z$faktor_code, ": ", z$faktor_name)), tags$td(if (is.na(z$wert)) "n. b." else z$wert), tags$td(z$ref_m), tags$td(z$ref_sd), tags$td(if (is.na(z$diff_sd)) "n. b." else sprintf("%.2f", z$diff_sd)) ) }) faktor_bloecke = lapply(sort(unique(d$items_df$faktor)), function(fc) { block = mkf30_item_block_sortiert(d$items_df, fc) item_zeilen = lapply(seq_len(nrow(block)), function(i) { z = block[i, ] sk = if (!is.na(z$wert) && z$wert >= 1 && z$wert <= 4) as.character(z$wert) else "na" div(class = "item-zeile", div(class = "item-nr", paste0(z$nummer, ".")), div(class = "item-text", z$text), span(class = paste0("item-wert item-wert-", sk), mkf30_antwort_label(z$wert)) ) }) div(class = "abschnitt-karte", div(class = "abschnitt-titel", paste0("F", fc, ": ", MKF30_FAKTOR_NAMEN[[fc]])), div(item_zeilen) ) }) tagList( div(class = "abschnitt-karte", div(class = "abschnitt-titel", "Faktor-Ergebnisse"), div(class = "meta-block", tags$strong("Chiffre: "), d$chiffre, tags$span(" | ", style = "color:#ccc;"), tags$strong("Ausfuelldatum: "), d$datum_str ), div(class = "hinweis-text", paste0( "Die Referenzwerte stammen aus der studentischen Validierungsstichprobe ", "(Arndt et al., 2011) und dienen ausschliesslich der groben Einordnung, ", "nicht der klinischen Bewertung. Es gibt fuer den MKF-30 keine etablierten Cutoffs." )), tags$table(class = "ergebnis-tabelle", tags$thead( tags$tr( tags$th("Faktor"), tags$th("Wert"), tags$th("Referenz M"), tags$th("Referenz SD"), tags$th("Differenz (SD)") ) ), tags$tbody(tabellen_zeilen) ) ), faktor_bloecke ) }) output$download_word = downloadHandler( filename = function() { d = tryCatch(ergebnis_r(), error = function(e) NULL) chiffre = if (is.list(d) && is.null(d$error)) d$chiffre else "export" datum = if (is.list(d) && is.null(d$error)) d$datum_yyyymmdd else format(Sys.Date(), "%Y%m%d") paste0("MKF30_", 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 eingeben und 'Auswerten' klicken.", style = "Normal") print(doc, target = file) return() } doc = tryCatch( erstelle_mkf30_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)