Compare commits
19 Commits
d73699a1d1
...
devel
| Author | SHA1 | Date | |
|---|---|---|---|
| e07d6f70e3 | |||
| ab949ee9c2 | |||
| fc2e518d7e | |||
| 14839dee5f | |||
| 915f3e9810 | |||
| fcd19fb09e | |||
| 989cc9b219 | |||
| b428c976d5 | |||
| fb4335006d | |||
| 12c17d3766 | |||
| dc51156490 | |||
| 8f3343a103 | |||
| 4baec1003a | |||
| 7ed3ee0480 | |||
| a178480912 | |||
| a4d829e3dd | |||
| 89d58c8df5 | |||
| 4c50473c7e | |||
| df740c4f71 |
@@ -28,6 +28,7 @@ source("renv/activate.R")
|
|||||||
cli::cli_code(paste0("R_CONFIG_ACTIVE", "="))
|
cli::cli_code(paste0("R_CONFIG_ACTIVE", "="))
|
||||||
|
|
||||||
}
|
}
|
||||||
|
Sys.setenv(R_CONFIG_FILE = "config/config.yml")
|
||||||
|
|
||||||
})()
|
})()
|
||||||
|
|
||||||
@@ -35,8 +36,8 @@ source("renv/activate.R")
|
|||||||
# при первом запуске скопировать пример конфига
|
# при первом запуске скопировать пример конфига
|
||||||
(function() {
|
(function() {
|
||||||
|
|
||||||
if (!file.exists("config.yml")) {
|
if (!file.exists("config/config.yml")) {
|
||||||
file.copy("config_example.yml", "config.yml")
|
file.copy("config/config_example.yml", "config/config.yml")
|
||||||
}
|
}
|
||||||
|
|
||||||
})()
|
})()
|
||||||
|
|||||||
2
.gitignore
vendored
2
.gitignore
vendored
@@ -3,7 +3,7 @@
|
|||||||
/_devel
|
/_devel
|
||||||
/all_bases
|
/all_bases
|
||||||
|
|
||||||
config.yml
|
config/config.yml
|
||||||
|
|
||||||
.Renviron
|
.Renviron
|
||||||
.DS_Store
|
.DS_Store
|
||||||
|
|||||||
@@ -1,3 +1,11 @@
|
|||||||
|
### 0.18.2 - 0.18.3 (2026-06-18)
|
||||||
|
##### features
|
||||||
|
- возможность отражение лога действий по базам (для администраторов) и отдельно для каждой записи (сгруппированы по уникальным действиям)
|
||||||
|
- возможность экспорта таблицы со списком значений не прошедшие валидацию согласно схеме (для администраторов)
|
||||||
|
|
||||||
|
##### refactor
|
||||||
|
- перестройка структуры репозитория
|
||||||
|
|
||||||
### 0.18.1 (2026-06-08)
|
### 0.18.1 (2026-06-08)
|
||||||
##### fix
|
##### fix
|
||||||
- правильный экспорт текстовых данных
|
- правильный экспорт текстовых данных
|
||||||
|
|||||||
@@ -1,5 +1,7 @@
|
|||||||
options(box.path = here::here())
|
options(box.path = here::here())
|
||||||
box::use(R/modules/data_manipulations[is_this_empty_value])
|
box::use(
|
||||||
|
R/modules/data_manipulations[is_this_empty_value]
|
||||||
|
)
|
||||||
|
|
||||||
#' @export
|
#' @export
|
||||||
init_val = function(scheme, ns) {
|
init_val = function(scheme, ns) {
|
||||||
@@ -115,3 +117,133 @@ val_choice_within_a_dict = function(x, choices) {
|
|||||||
glue::glue("варианты, не соответствующие схеме: {text}")
|
glue::glue("варианты, не соответствующие схеме: {text}")
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# ЭКСПОРТ ДАННЫХ ДЛЯ ВАЛИДАЦИИ
|
||||||
|
#' @export
|
||||||
|
validate_value_for_form <- function(data_to_check, form_type, choices, val_required) {
|
||||||
|
|
||||||
|
res <- NULL
|
||||||
|
# for `number` type: if in `choices` column has values then parsing them to range validation
|
||||||
|
# value `0; 250` -> transform to rule validation value from 0 to 250
|
||||||
|
if (form_type == "number") {
|
||||||
|
|
||||||
|
res <- val_is_a_number(data_to_check)
|
||||||
|
if(!is.null(res)) return(res)
|
||||||
|
|
||||||
|
# проверка на соответствие диапазону значений
|
||||||
|
if (!is.na(choices)) {
|
||||||
|
|
||||||
|
# разделить на несколько елементов
|
||||||
|
ranges <- as.integer(stringr::str_split_1(choices, "; "))
|
||||||
|
|
||||||
|
# проверка на кол-во значений
|
||||||
|
if (length(ranges) > 3) {
|
||||||
|
warning("Количество переданных элементов'", x_input_id, "' > 2")
|
||||||
|
} else {
|
||||||
|
|
||||||
|
res <- val_number_within_a_range(data_to_check, ranges = ranges)
|
||||||
|
if (!is.null(res)) return(res)
|
||||||
|
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (form_type %in% c("select_multiple", "select_one", "radio", "checkbox")) {
|
||||||
|
|
||||||
|
if (!is_this_empty_value(data_to_check)) {
|
||||||
|
split_data <- stringr::str_split_1(data_to_check, "; ")
|
||||||
|
} else {
|
||||||
|
split_data <- NA
|
||||||
|
}
|
||||||
|
|
||||||
|
res <- val_choice_within_a_dict(split_data, choices = choices)
|
||||||
|
if(!is.null(res)) return(res)
|
||||||
|
}
|
||||||
|
|
||||||
|
# if in `required` column value is `1` apply standart validation
|
||||||
|
if (!is.na(val_required) && val_required == 1) {
|
||||||
|
|
||||||
|
if (is_this_empty_value(data_to_check)) {
|
||||||
|
|
||||||
|
res <- "Необходимо заполнить."
|
||||||
|
if(!is.null(res)) return(res)
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
if(is.null(res)) return(NA)
|
||||||
|
}
|
||||||
|
|
||||||
|
#' @export
|
||||||
|
get_table_with_data_validation_info <- function(schm, con) {
|
||||||
|
|
||||||
|
# итерациям по всем таблицам
|
||||||
|
purrr::map(
|
||||||
|
purrr::set_names(schm$all_tables_names),
|
||||||
|
.f = \(table_name) {
|
||||||
|
|
||||||
|
scheme <- schm$get_scheme(table_name)
|
||||||
|
data <- DBI::dbReadTable(con, table_name)
|
||||||
|
|
||||||
|
inputs_simple_list <- schm$get_id_type_list(table_name)
|
||||||
|
|
||||||
|
main_key <- schm$get_main_key_id
|
||||||
|
key <- schm$get_key_id(table_name)
|
||||||
|
|
||||||
|
# итерация по всем form_id в текущей таблице
|
||||||
|
ff <- purrr::map2(
|
||||||
|
.x = names(inputs_simple_list),
|
||||||
|
.y = unname(inputs_simple_list),
|
||||||
|
.f = \(x_input_id, y_form_type) {
|
||||||
|
|
||||||
|
this_id_scheme <- dplyr::filter(scheme, form_id == {{x_input_id}})
|
||||||
|
|
||||||
|
choices <- this_id_scheme$choices
|
||||||
|
val_required <- unique(this_id_scheme$required)
|
||||||
|
|
||||||
|
# extract data
|
||||||
|
data_to_check <- data[[x_input_id]]
|
||||||
|
main_keys <- data[[main_key]]
|
||||||
|
keys <- data[[key]]
|
||||||
|
iter <- purrr::set_names(data_to_check, keys)
|
||||||
|
|
||||||
|
# cli::cli_inform("~ input_id: {x_input_id} | type: {form_type} | value: {data_to_check}")
|
||||||
|
validation_info <- purrr::map(iter, validate_value_for_form, y_form_type, choices, val_required)
|
||||||
|
|
||||||
|
df_with_result_and_validation_for_id <- tibble::enframe(validation_info, name = key, value = "value") |>
|
||||||
|
tidyr::unnest(cols = c(value))
|
||||||
|
|
||||||
|
# если главный ключ и ключ для таблицы не одно и тоже, добавление главного ключа в таблицу
|
||||||
|
if (main_key != key) {
|
||||||
|
df_with_result_and_validation_for_id[main_key] <- main_keys
|
||||||
|
}
|
||||||
|
|
||||||
|
df_with_result_and_validation_for_id |>
|
||||||
|
dplyr::mutate(form_id = x_input_id)
|
||||||
|
|
||||||
|
}) |>
|
||||||
|
purrr::list_rbind()
|
||||||
|
|
||||||
|
ff |>
|
||||||
|
dplyr::distinct() |>
|
||||||
|
dplyr::filter(!is.na(value)) |>
|
||||||
|
# данные схемы для 'читабельности информации'
|
||||||
|
dplyr::left_join(
|
||||||
|
y = scheme |> dplyr::distinct(form_id, form_label) |> dplyr::mutate(nr = dplyr::row_number()),
|
||||||
|
by = dplyr::join_by(form_id),
|
||||||
|
) |>
|
||||||
|
# сортировка (main_key, затем id формы - по порядку в схеме)
|
||||||
|
dplyr::arrange(!!rlang::sym(main_key), !!rlang::sym(main_key), nr) |>
|
||||||
|
dplyr::select(
|
||||||
|
!!rlang::sym(main_key), !!rlang::sym(main_key),
|
||||||
|
form_id,
|
||||||
|
form_label,
|
||||||
|
value
|
||||||
|
)
|
||||||
|
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -1,19 +1,33 @@
|
|||||||
.on_load = function(ns) {
|
|
||||||
|
|
||||||
check_and_init_scheme()
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
#' @export
|
#' @export
|
||||||
#' @description костыли для упрощения работы себе
|
#' @description костыли для упрощения работы себе
|
||||||
set_global_options = function(
|
set_global_options = function(
|
||||||
SYMBOL_DELIM = "; ",
|
SYMBOL_DELIM = "; ",
|
||||||
APP.DEBUG = FALSE,
|
|
||||||
# shiny.host = "127.0.0.1",
|
|
||||||
# shiny.port = 1338,
|
|
||||||
...
|
...
|
||||||
) {
|
) {
|
||||||
|
|
||||||
|
options(
|
||||||
|
SYMBOL_DELIM = SYMBOL_DELIM,
|
||||||
|
...
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
# global vars ------------------------------------
|
||||||
|
#' @export
|
||||||
|
AUTH_ENABLED <- config::get("form_auth_enabled")
|
||||||
|
|
||||||
|
#' @export
|
||||||
|
#' TODO: нормальный разворот
|
||||||
|
ENABLED_SCHEMES <- unlist(config::get()$form_schemes)
|
||||||
|
ENABLED_SCHEMES <- stats::setNames(names(ENABLED_SCHEMES), ENABLED_SCHEMES)
|
||||||
|
|
||||||
|
# -------------------------------------------------
|
||||||
|
|
||||||
|
#' @export
|
||||||
|
check_and_init_scheme = function() {
|
||||||
|
|
||||||
|
cli::cli_inform(c("*" = "проверка файла конфигурации..."))
|
||||||
|
|
||||||
config_params_to_check <- c(
|
config_params_to_check <- c(
|
||||||
"form_app_version",
|
"form_app_version",
|
||||||
"form_id",
|
"form_id",
|
||||||
@@ -24,28 +38,14 @@ set_global_options = function(
|
|||||||
)
|
)
|
||||||
|
|
||||||
expected_params_in_config <- config_params_to_check %in% names(config::get())
|
expected_params_in_config <- config_params_to_check %in% names(config::get())
|
||||||
|
|
||||||
if (!all(expected_params_in_config)) {
|
if (!all(expected_params_in_config)) {
|
||||||
cli::cli_abort(c(
|
cli::cli_abort(c(
|
||||||
"Необходимо добавить в файл конфига {.file config.yml} следующие параметры:",
|
"Необходимо добавить в файл конфига {.file config.yml} следующие параметры:",
|
||||||
paste0(config_params_to_check[!expected_params_in_config], ":")
|
paste0(config_params_to_check[!expected_params_in_config], ":")
|
||||||
))
|
))
|
||||||
}
|
}
|
||||||
|
# -------------------
|
||||||
options(
|
|
||||||
SYMBOL_DELIM = SYMBOL_DELIM,
|
|
||||||
# form.db_path = config::get("form_db_path"),
|
|
||||||
APP.DEBUG = APP.DEBUG,
|
|
||||||
# shiny.host = shiny.host,
|
|
||||||
# shiny.port = shiny.port,
|
|
||||||
...
|
|
||||||
)
|
|
||||||
}
|
|
||||||
|
|
||||||
#' @export
|
|
||||||
AUTH_ENABLED <- config::get("form_auth_enabled")
|
|
||||||
|
|
||||||
#' @export
|
|
||||||
check_and_init_scheme = function() {
|
|
||||||
|
|
||||||
cli::cli_inform(c("*" = "проверка схемы..."))
|
cli::cli_inform(c("*" = "проверка схемы..."))
|
||||||
|
|
||||||
@@ -56,7 +56,7 @@ check_and_init_scheme = function() {
|
|||||||
|
|
||||||
# список файлов, изменение которых, приведут к переинициализиации схемы
|
# список файлов, изменение которых, приведут к переинициализиации схемы
|
||||||
files_to_watch <- c(
|
files_to_watch <- c(
|
||||||
"config.yml",
|
"config/config.yml",
|
||||||
"R/modules/scheme_generator.R",
|
"R/modules/scheme_generator.R",
|
||||||
"R/modules/utils.R"
|
"R/modules/utils.R"
|
||||||
)
|
)
|
||||||
@@ -76,13 +76,14 @@ check_and_init_scheme = function() {
|
|||||||
|
|
||||||
db_files <- paste0(config::get("form_app_configure_path"), "/db/", scheme_names, ".sqlite")
|
db_files <- paste0(config::get("form_app_configure_path"), "/db/", scheme_names, ".sqlite")
|
||||||
|
|
||||||
|
if (!dir.exists("temp")) dir.create("temp")
|
||||||
hash_file <- "temp/schema_hash.rds"
|
hash_file <- "temp/schema_hash.rds"
|
||||||
|
|
||||||
#
|
#
|
||||||
exist_hash <- tools::md5sum(c(scheme_file, files_to_watch))
|
exist_hash <- tools::md5sum(c(scheme_file, files_to_watch))
|
||||||
|
|
||||||
# если первый запуск (нет файла с кешем) инициализация схемы
|
# если первый запуск (нет файла с кешем) инициализация схемы
|
||||||
if (!file.exists(hash_file) | !file.exists("temp/scheme.rds") | !all(file.exists(db_files))) {
|
if (!file.exists(hash_file) | !file.exists("temp/scheme.rds")) {
|
||||||
|
|
||||||
init_scheme(scheme_file)
|
init_scheme(scheme_file)
|
||||||
|
|
||||||
|
|||||||
@@ -49,7 +49,7 @@ scheme_R6 <- R6::R6Class(
|
|||||||
"task_status", "select_one", "Статус задачи", NA, "deleted",
|
"task_status", "select_one", "Статус задачи", NA, "deleted",
|
||||||
"task_title", "text", "Название задачи", NA, NA,
|
"task_title", "text", "Название задачи", NA, NA,
|
||||||
"task_description", "text", "Описание задачи", "краткое описание", "3",
|
"task_description", "text", "Описание задачи", "краткое описание", "3",
|
||||||
"task_due_date", "date", "Дата выполнения задачи", NA, NA,
|
"task_due_date", "date", "Срок выполнения задачи", NA, NA,
|
||||||
) |>
|
) |>
|
||||||
dplyr::mutate(condition = NA)
|
dplyr::mutate(condition = NA)
|
||||||
|
|
||||||
@@ -168,16 +168,3 @@ scheme_R6 <- R6::R6Class(
|
|||||||
}
|
}
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
# object.size(schm)
|
|
||||||
# schm$get_key_id("main")
|
|
||||||
# schm$get_forms_ids("main")
|
|
||||||
# schm$get_all_ids("main")
|
|
||||||
|
|
||||||
# schm$get_scheme("main")
|
|
||||||
|
|
||||||
# schm$get_id_type_list("allergo_anamnesis")
|
|
||||||
|
|
||||||
# # active
|
|
||||||
# schm$get_main_key_id
|
|
||||||
# schm$all_tables_names
|
|
||||||
@@ -108,7 +108,11 @@ render_forms = function(
|
|||||||
} else {
|
} else {
|
||||||
shiny::tagList(
|
shiny::tagList(
|
||||||
if (!is.na(form_label)) {
|
if (!is.na(form_label)) {
|
||||||
|
if (form_type == "description_header") {
|
||||||
|
shiny::span(form_label, class = "description-header", style = "color: #444444; font-weight: 550; line-height: 1.4;")
|
||||||
|
} else {
|
||||||
shiny::span(form_label, style = "color: #444444; font-weight: 550; line-height: 1.4;")
|
shiny::span(form_label, style = "color: #444444; font-weight: 550; line-height: 1.4;")
|
||||||
|
}
|
||||||
# если в схеме есть поле с описанием - добавляем его следующей строчкой
|
# если в схеме есть поле с описанием - добавляем его следующей строчкой
|
||||||
},
|
},
|
||||||
if (!is.na(description) && !is.na(form_label)) shiny::br(),
|
if (!is.na(description) && !is.na(form_label)) shiny::br(),
|
||||||
|
|||||||
@@ -14,7 +14,7 @@ credentials <- data.frame(
|
|||||||
# Init the database
|
# Init the database
|
||||||
shinymanager::create_db(
|
shinymanager::create_db(
|
||||||
credentials_data = credentials,
|
credentials_data = credentials,
|
||||||
sqlite_path = "auth.sqlite", # will be created
|
sqlite_path = "temp/auth.sqlite", # will be created
|
||||||
passphrase = Sys.getenv("AUTH_DB_KEY")
|
passphrase = Sys.getenv("AUTH_DB_KEY")
|
||||||
# passphrase = "passphrase_wihtout_keyring"
|
# passphrase = "passphrase_wihtout_keyring"
|
||||||
)
|
)
|
||||||
|
|||||||
BIN
all_bases/schemas/orphans_and_amyloidosis.xlsx
Normal file
BIN
all_bases/schemas/orphans_and_amyloidosis.xlsx
Normal file
Binary file not shown.
155
app.R
155
app.R
@@ -9,7 +9,6 @@ box::use(
|
|||||||
# modules
|
# modules
|
||||||
box::use(
|
box::use(
|
||||||
R/modules/utils,
|
R/modules/utils,
|
||||||
R/modules/global_options,
|
|
||||||
R/modules/db,
|
R/modules/db,
|
||||||
R/modules/data_validation,
|
R/modules/data_validation,
|
||||||
R/app/forms,
|
R/app/forms,
|
||||||
@@ -18,22 +17,22 @@ box::use(
|
|||||||
R/modules/data_manipulations[is_this_empty_value]
|
R/modules/data_manipulations[is_this_empty_value]
|
||||||
)
|
)
|
||||||
|
|
||||||
|
# глобальные переменные и проверка/инициация схемы:
|
||||||
|
box::use(
|
||||||
|
R/modules/global_options[set_global_options, check_and_init_scheme],
|
||||||
|
R/modules/global_options[AUTH_ENABLED, ENABLED_SCHEMES],
|
||||||
|
)
|
||||||
|
|
||||||
# set global settings:
|
# set global settings:
|
||||||
global_options$set_global_options(
|
set_global_options(
|
||||||
shiny.host = "0.0.0.0",
|
shiny.host = "0.0.0.0",
|
||||||
shiny.port = 1338,
|
shiny.port = 1338,
|
||||||
APP.DEBUG = FALSE
|
APP.DEBUG = FALSE
|
||||||
)
|
)
|
||||||
|
|
||||||
# global vars:
|
check_and_init_scheme()
|
||||||
box::use(
|
|
||||||
R/modules/global_options[AUTH_ENABLED]
|
|
||||||
)
|
|
||||||
enabled_schemes <- unlist(config::get()$form_schemes)
|
|
||||||
enabled_schemes <- setNames(names(enabled_schemes), enabled_schemes)
|
|
||||||
|
|
||||||
# load schemes object:
|
SCHMS <- readRDS("temp/scheme.rds")
|
||||||
schms <- readRDS("temp/scheme.rds")
|
|
||||||
|
|
||||||
# CHECK FOR PANDOC ----------
|
# CHECK FOR PANDOC ----------
|
||||||
# rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/")
|
# rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/")
|
||||||
@@ -43,15 +42,18 @@ if (!rmarkdown::pandoc_available()) warning("Can't find pandoc!")
|
|||||||
|
|
||||||
# web resources ------
|
# web resources ------
|
||||||
shiny::addResourcePath("www", "www")
|
shiny::addResourcePath("www", "www")
|
||||||
|
shiny::resourcePaths()
|
||||||
|
|
||||||
# UI =======================
|
# UI =======================
|
||||||
ui <- page_sidebar(
|
ui <- page_sidebar(
|
||||||
title = config::get("form_name"),
|
title = config::get("form_name"),
|
||||||
theme = bs_theme(version = 5, preset = "bootstrap"),
|
theme = bs_theme(version = 5, preset = "bootstrap"),
|
||||||
header = tags$head(
|
|
||||||
|
tags$head(
|
||||||
|
tags$link(rel = "stylesheet", type = "text/css", href = "www/styles.css"),
|
||||||
tags$link(rel = "icon", href = "www/favicon.ico")
|
tags$link(rel = "icon", href = "www/favicon.ico")
|
||||||
),
|
),
|
||||||
|
|
||||||
sidebar = sidebar(
|
sidebar = sidebar(
|
||||||
actionButton("add_new_main_key_button", "Добавить новую запись", icon("plus", lib = "font-awesome")),
|
actionButton("add_new_main_key_button", "Добавить новую запись", icon("plus", lib = "font-awesome")),
|
||||||
actionButton("save_data_button", "Сохранить данные", icon("floppy-disk", lib = "font-awesome")),
|
actionButton("save_data_button", "Сохранить данные", icon("floppy-disk", lib = "font-awesome")),
|
||||||
@@ -113,7 +115,7 @@ server <- function(input, output, session) {
|
|||||||
# check_credentials directly on sqlite db
|
# check_credentials directly on sqlite db
|
||||||
shinymanager::secure_server(
|
shinymanager::secure_server(
|
||||||
check_credentials = shinymanager::check_credentials(
|
check_credentials = shinymanager::check_credentials(
|
||||||
db = "auth.sqlite",
|
db = "temp/auth.sqlite",
|
||||||
passphrase = Sys.getenv("AUTH_DB_KEY")
|
passphrase = Sys.getenv("AUTH_DB_KEY")
|
||||||
),
|
),
|
||||||
keep_token = TRUE
|
keep_token = TRUE
|
||||||
@@ -130,7 +132,7 @@ server <- function(input, output, session) {
|
|||||||
forms_access <- stringr::str_split_1(string, ", ")
|
forms_access <- stringr::str_split_1(string, ", ")
|
||||||
|
|
||||||
# check if exists
|
# check if exists
|
||||||
exists <- forms_access %in% enabled_schemes
|
exists <- forms_access %in% ENABLED_SCHEMES
|
||||||
if (!all(exists)) {
|
if (!all(exists)) {
|
||||||
cli::cli_warn(c("these forms is not exist:", paste("- ", forms_access[!exists])))
|
cli::cli_warn(c("these forms is not exist:", paste("- ", forms_access[!exists])))
|
||||||
}
|
}
|
||||||
@@ -161,13 +163,14 @@ server <- function(input, output, session) {
|
|||||||
tagList(
|
tagList(
|
||||||
strong("Импорт и экспорт данных для выбранной схемы:"),
|
strong("Импорт и экспорт данных для выбранной схемы:"),
|
||||||
verticalLayout(
|
verticalLayout(
|
||||||
downloadButton("downloadData", "Экспорт в .xlsx", style = "width: 250px; margin-top: 5px"),
|
downloadButton("downloadData", "Экспорт базы в .xlsx", style = "width: 250px; margin-top: 5px"),
|
||||||
actionButton("button_upload_data_from_xlsx", "импорт!", icon("file-import", lib = "font-awesome"), style = "width: 250px; margin-top: 10px"),
|
actionButton("button_upload_data_from_xlsx", "Импорт базы из .xlsx", icon("file-import", lib = "font-awesome"), style = "width: 250px; margin-top: 10px"),
|
||||||
fluid = FALSE
|
fluid = FALSE
|
||||||
),
|
),
|
||||||
strong("Дополнительные опции:"),
|
strong("Дополнительные опции:"),
|
||||||
verticalLayout(
|
verticalLayout(
|
||||||
actionButton("logs-show_last_actions", "Все действия", icon("scroll", lib = "font-awesome"), style = "width: 250px; margin-top: 10px"),
|
actionButton("logs-show_last_actions", "Все действия", icon("scroll", lib = "font-awesome"), style = "width: 250px; margin-top: 10px"),
|
||||||
|
downloadButton("download_data_validation_info", "Некорректно заполненные данные (.xlsx)", icon("scroll", lib = "font-awesome"), style = "width: 250px; margin-top: 10px"),
|
||||||
fluid = FALSE
|
fluid = FALSE
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@@ -187,7 +190,7 @@ server <- function(input, output, session) {
|
|||||||
nested_form_id = NULL,
|
nested_form_id = NULL,
|
||||||
tasks_id = NULL,
|
tasks_id = NULL,
|
||||||
current_user = NULL,
|
current_user = NULL,
|
||||||
user_form_access = enabled_schemes
|
user_form_access = ENABLED_SCHEMES
|
||||||
)
|
)
|
||||||
|
|
||||||
scheme <- reactiveVal(NULL) # наименование выбранной схемы
|
scheme <- reactiveVal(NULL) # наименование выбранной схемы
|
||||||
@@ -215,16 +218,16 @@ server <- function(input, output, session) {
|
|||||||
allowed_schemas <- if (is.na(res)) {
|
allowed_schemas <- if (is.na(res)) {
|
||||||
NA # нет доступа
|
NA # нет доступа
|
||||||
} else if (res == "all") {
|
} else if (res == "all") {
|
||||||
enabled_schemes # все схемы
|
ENABLED_SCHEMES # все схемы
|
||||||
} else {
|
} else {
|
||||||
enabled_schemes[enabled_schemes == res] # только указанные
|
ENABLED_SCHEMES[ENABLED_SCHEMES == res] # только указанные
|
||||||
}
|
}
|
||||||
|
|
||||||
# переопределяем переменные
|
# переопределяем переменные
|
||||||
main_form_is_empty(ifelse(is.na(res), "empty", "main_menu"))
|
main_form_is_empty(ifelse(is.na(res), "empty", "main_menu"))
|
||||||
values$user_form_access <- allowed_schemas
|
values$user_form_access <- allowed_schemas
|
||||||
scheme(values$user_form_access[1])
|
scheme(values$user_form_access[1])
|
||||||
mhcs(schms[[values$user_form_access[1]]])
|
mhcs(SCHMS[[values$user_form_access[1]]])
|
||||||
})
|
})
|
||||||
|
|
||||||
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||||
@@ -324,7 +327,7 @@ server <- function(input, output, session) {
|
|||||||
observeEvent(input$schmes_selector, {
|
observeEvent(input$schmes_selector, {
|
||||||
|
|
||||||
scheme(input$schmes_selector)
|
scheme(input$schmes_selector)
|
||||||
mhcs(schms[[input$schmes_selector]])
|
mhcs(SCHMS[[input$schmes_selector]])
|
||||||
|
|
||||||
})
|
})
|
||||||
|
|
||||||
@@ -370,13 +373,13 @@ server <- function(input, output, session) {
|
|||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
exported_df <- setNames(exported_values, input_ids) |>
|
exported_df <- stats::setNames(exported_values, input_ids) |>
|
||||||
as_tibble()
|
dplyr::as_tibble()
|
||||||
|
|
||||||
# пайплайн для главной таблицы
|
# пайплайн для главной таблицы
|
||||||
if (table_name == "main") {
|
if (table_name == "main") {
|
||||||
exported_df <- exported_df |>
|
exported_df <- exported_df |>
|
||||||
mutate(
|
dplyr::mutate(
|
||||||
!!dplyr::sym(mhcs()$get_main_key_id) := values$main_key,
|
!!dplyr::sym(mhcs()$get_main_key_id) := values$main_key,
|
||||||
.before = 1
|
.before = 1
|
||||||
)
|
)
|
||||||
@@ -385,7 +388,7 @@ server <- function(input, output, session) {
|
|||||||
# для всех остальных таблицы (вложенные)
|
# для всех остальных таблицы (вложенные)
|
||||||
if (table_name != "main") {
|
if (table_name != "main") {
|
||||||
exported_df <- exported_df |>
|
exported_df <- exported_df |>
|
||||||
mutate(
|
dplyr::mutate(
|
||||||
!!dplyr::sym(mhcs()$get_main_key_id) := values$main_key,
|
!!dplyr::sym(mhcs()$get_main_key_id) := values$main_key,
|
||||||
!!dplyr::sym(nested_key_id) := values$nested_key,
|
!!dplyr::sym(nested_key_id) := values$nested_key,
|
||||||
.before = 1
|
.before = 1
|
||||||
@@ -471,7 +474,7 @@ server <- function(input, output, session) {
|
|||||||
|
|
||||||
# если ключ в формате даты - дать человекочитаемые данные
|
# если ключ в формате даты - дать человекочитаемые данные
|
||||||
if (this_nested_form_key_scheme_smoll$form_type == "date") {
|
if (this_nested_form_key_scheme_smoll$form_type == "date") {
|
||||||
kyes_for_this_table <- setNames(
|
kyes_for_this_table <- stats::setNames(
|
||||||
kyes_for_this_table,
|
kyes_for_this_table,
|
||||||
format(as.Date(kyes_for_this_table), "%d.%m.%Y")
|
format(as.Date(kyes_for_this_table), "%d.%m.%Y")
|
||||||
)
|
)
|
||||||
@@ -557,12 +560,12 @@ server <- function(input, output, session) {
|
|||||||
str_cols <- which(col_types$form_type != "date")
|
str_cols <- which(col_types$form_type != "date")
|
||||||
|
|
||||||
values$data <- values$data |>
|
values$data <- values$data |>
|
||||||
select(-mhcs()$get_main_key_id) |>
|
dplyr::select(-mhcs()$get_main_key_id) |>
|
||||||
mutate(
|
dplyr::mutate(
|
||||||
dplyr::across(tidyselect::all_of({{date_cols}}), as.Date),
|
dplyr::across(tidyselect::all_of({{date_cols}}), as.Date),
|
||||||
dplyr::across(tidyselect::all_of({{str_cols}}), as.character),
|
dplyr::across(tidyselect::all_of({{str_cols}}), as.character),
|
||||||
) |>
|
) |>
|
||||||
arrange({{key_id}})
|
dplyr::arrange({{key_id}})
|
||||||
|
|
||||||
output$dt_nested <- DT::renderDataTable(
|
output$dt_nested <- DT::renderDataTable(
|
||||||
DT::datatable(
|
DT::datatable(
|
||||||
@@ -728,7 +731,7 @@ server <- function(input, output, session) {
|
|||||||
|
|
||||||
ui1 <- rlang::exec(
|
ui1 <- rlang::exec(
|
||||||
.fn = utils$render_forms,
|
.fn = utils$render_forms,
|
||||||
!!!distinct(scheme_for_key_input, form_id, form_label, form_type),
|
!!!dplyr::distinct(scheme_for_key_input, form_id, form_label, form_type),
|
||||||
main_scheme = scheme_for_key_input
|
main_scheme = scheme_for_key_input
|
||||||
)
|
)
|
||||||
|
|
||||||
@@ -780,7 +783,7 @@ server <- function(input, output, session) {
|
|||||||
need(values$main_key, "⚠️ Необходимо указать id пациента!")
|
need(values$main_key, "⚠️ Необходимо указать id пациента!")
|
||||||
)
|
)
|
||||||
span(
|
span(
|
||||||
strong("Таблица: "), names(enabled_schemes)[enabled_schemes == scheme()],
|
strong("Таблица: "), names(ENABLED_SCHEMES)[ENABLED_SCHEMES == scheme()],
|
||||||
br(),
|
br(),
|
||||||
strong("ID: "), values$main_key
|
strong("ID: "), values$main_key
|
||||||
)
|
)
|
||||||
@@ -812,7 +815,7 @@ server <- function(input, output, session) {
|
|||||||
# создать форму для выбора ключа
|
# создать форму для выбора ключа
|
||||||
ui1 <- rlang::exec(
|
ui1 <- rlang::exec(
|
||||||
.fn = utils$render_forms,
|
.fn = utils$render_forms,
|
||||||
!!!distinct(scheme_for_key_input, form_id, form_label, form_type),
|
!!!dplyr::distinct(scheme_for_key_input, form_id, form_label, form_type),
|
||||||
main_scheme = scheme_for_key_input
|
main_scheme = scheme_for_key_input
|
||||||
)
|
)
|
||||||
|
|
||||||
@@ -909,7 +912,7 @@ server <- function(input, output, session) {
|
|||||||
con <- db$make_db_connection(scheme(),"load_data_button")
|
con <- db$make_db_connection(scheme(),"load_data_button")
|
||||||
on.exit(db$close_db_connection(con, "load_data_button"))
|
on.exit(db$close_db_connection(con, "load_data_button"))
|
||||||
|
|
||||||
if (length(dbListTables(con)) != 0 && "main" %in% DBI::dbListTables(con)) {
|
if (length(DBI::dbListTables(con)) != 0 && "main" %in% DBI::dbListTables(con)) {
|
||||||
|
|
||||||
# GET DATA files
|
# GET DATA files
|
||||||
ids <- db$get_keys_from_table("main", mhcs(), con)
|
ids <- db$get_keys_from_table("main", mhcs(), con)
|
||||||
@@ -921,7 +924,7 @@ server <- function(input, output, session) {
|
|||||||
choices = ids,
|
choices = ids,
|
||||||
selected = NULL,
|
selected = NULL,
|
||||||
options = list(
|
options = list(
|
||||||
placeholder = "id пациента",
|
placeholder = "id",
|
||||||
onInitialize = I('function() { this.setValue(""); }')
|
onInitialize = I('function() { this.setValue(""); }')
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@@ -1041,7 +1044,7 @@ server <- function(input, output, session) {
|
|||||||
list_of_df[["meta"]] <- dplyr::tribble(
|
list_of_df[["meta"]] <- dplyr::tribble(
|
||||||
~`Параметр` , ~`Значение`,
|
~`Параметр` , ~`Значение`,
|
||||||
"Пользователь" , values$current_user,
|
"Пользователь" , values$current_user,
|
||||||
"Название базы" , names(enabled_schemes)[enabled_schemes == scheme()],
|
"Название базы" , names(ENABLED_SCHEMES)[ENABLED_SCHEMES == scheme()],
|
||||||
"id базы" , scheme(),
|
"id базы" , scheme(),
|
||||||
"id формы" , config::get("form_id"),
|
"id формы" , config::get("form_id"),
|
||||||
"ver формы" , config::get("form_app_version"),
|
"ver формы" , config::get("form_app_version"),
|
||||||
@@ -1149,7 +1152,7 @@ server <- function(input, output, session) {
|
|||||||
# write vector to temp .Rmd file
|
# write vector to temp .Rmd file
|
||||||
writeLines(empty_vec, temp_report, sep = "\n")
|
writeLines(empty_vec, temp_report, sep = "\n")
|
||||||
# copy template .docx file
|
# copy template .docx file
|
||||||
file.copy("references/reference.docx", temp_template, overwrite = TRUE)
|
file.copy("resources/references/reference.docx", temp_template, overwrite = TRUE)
|
||||||
|
|
||||||
# render file via pandoc
|
# render file via pandoc
|
||||||
rmarkdown::render(
|
rmarkdown::render(
|
||||||
@@ -1261,10 +1264,10 @@ server <- function(input, output, session) {
|
|||||||
dplyr::across(tidyselect::all_of({{number_columns}}), num_converter),
|
dplyr::across(tidyselect::all_of({{number_columns}}), num_converter),
|
||||||
dplyr::across(tidyselect::all_of({{other_cols}}), \(x) dplyr::if_else(x == "", as.character(NA), as.character(x)))
|
dplyr::across(tidyselect::all_of({{other_cols}}), \(x) dplyr::if_else(x == "", as.character(NA), as.character(x)))
|
||||||
) |>
|
) |>
|
||||||
select(all_of(unique(c(main_key_id, scheme$form_id))))
|
dplyr::select(tidyselect::all_of(unique(c(main_key_id, scheme$form_id))))
|
||||||
|
|
||||||
df_original <- DBI::dbReadTable(con, table_name) |>
|
df_original <- DBI::dbReadTable(con, table_name) |>
|
||||||
as_tibble()
|
dplyr::as_tibble()
|
||||||
|
|
||||||
if (input$upload_data_from_xlsx_owerwrite_all_data == TRUE) {
|
if (input$upload_data_from_xlsx_owerwrite_all_data == TRUE) {
|
||||||
|
|
||||||
@@ -1273,15 +1276,24 @@ server <- function(input, output, session) {
|
|||||||
} else {
|
} else {
|
||||||
|
|
||||||
# удаление данных в базе данных по ключам
|
# удаление данных в базе данных по ключам
|
||||||
walk(
|
# purrr::walk(
|
||||||
.x = unique(df[[main_key_id]]),
|
# .x = unique(df[[main_key_id]]),
|
||||||
.f = \(main_key) {
|
# .f = \(main_key) {
|
||||||
|
|
||||||
if (main_key %in% unique(df_original[[main_key_id]])) {
|
# if (main_key %in% unique(df_original[[main_key_id]])) {
|
||||||
DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE {main_key_id} = '{main_key}'"))
|
# DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE {main_key_id} = '{main_key}'"))
|
||||||
}
|
# }
|
||||||
}
|
# }
|
||||||
)
|
# )
|
||||||
|
|
||||||
|
# TODO
|
||||||
|
all_existed_keys <- unique(df_original[[main_key_id]])
|
||||||
|
all_new_keys <- unique(df[[main_key_id]])
|
||||||
|
|
||||||
|
keys_to_delete <- all_existed_keys[all_existed_keys %in% all_new_keys]
|
||||||
|
keys_to_delete <- paste0("'", keys_to_delete, "'", collapse = ", ")
|
||||||
|
|
||||||
|
DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE \"{main_key_id}\" IN ({keys_to_delete})"))
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -1319,7 +1331,7 @@ server <- function(input, output, session) {
|
|||||||
read_df_from_db_all <- function(table_name, con) {
|
read_df_from_db_all <- function(table_name, con) {
|
||||||
|
|
||||||
# check if this table exist
|
# check if this table exist
|
||||||
if (table_name %in% dbListTables(con)) {
|
if (table_name %in% DBI::dbListTables(con)) {
|
||||||
# prepare query
|
# prepare query
|
||||||
query <- glue::glue("
|
query <- glue::glue("
|
||||||
SELECT * FROM {table_name}
|
SELECT * FROM {table_name}
|
||||||
@@ -1338,6 +1350,7 @@ server <- function(input, output, session) {
|
|||||||
"loading data",
|
"loading data",
|
||||||
"creating new key",
|
"creating new key",
|
||||||
"exporting data to xlsx",
|
"exporting data to xlsx",
|
||||||
|
"export validation dataset",
|
||||||
"importing data from xlsx"
|
"importing data from xlsx"
|
||||||
),
|
),
|
||||||
key = NA,
|
key = NA,
|
||||||
@@ -1346,7 +1359,7 @@ server <- function(input, output, session) {
|
|||||||
|
|
||||||
action <- match.arg(action)
|
action <- match.arg(action)
|
||||||
|
|
||||||
action_row <- tibble(
|
action_row <- dplyr::tibble(
|
||||||
date = Sys.time(),
|
date = Sys.time(),
|
||||||
user = values$current_user,
|
user = values$current_user,
|
||||||
app_id = config::get("form_id"),
|
app_id = config::get("form_id"),
|
||||||
@@ -1365,6 +1378,52 @@ server <- function(input, output, session) {
|
|||||||
# SHOW LOGS -----------------------------------
|
# SHOW LOGS -----------------------------------
|
||||||
logs$server("logs", values, scheme, mhcs)
|
logs$server("logs", values, scheme, mhcs)
|
||||||
|
|
||||||
|
# экспорт таблицы с информации о валидации данных -------------------
|
||||||
|
output$download_data_validation_info <- downloadHandler(
|
||||||
|
filename = function(){
|
||||||
|
paste0("dvinfo_", isolate(scheme()), "_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".xlsx")
|
||||||
|
},
|
||||||
|
content = function(file) {
|
||||||
|
req(main_form_is_empty() != "empty")
|
||||||
|
|
||||||
|
box::use(
|
||||||
|
R/modules/data_validation[get_table_with_data_validation_info]
|
||||||
|
)
|
||||||
|
|
||||||
|
con <- db$make_db_connection(isolate(scheme()),"download_data_validation_info")
|
||||||
|
on.exit(db$close_db_connection(con, "download_data_validation_info"), add = TRUE)
|
||||||
|
|
||||||
|
list_of_df <- get_table_with_data_validation_info(mhcs(), con)
|
||||||
|
|
||||||
|
# добавить мета информацию
|
||||||
|
list_of_df[["meta"]] <- dplyr::tribble(
|
||||||
|
~`Параметр` , ~`Значение`,
|
||||||
|
"Пользователь" , values$current_user,
|
||||||
|
"Название базы" , names(ENABLED_SCHEMES)[ENABLED_SCHEMES == scheme()],
|
||||||
|
"id базы" , scheme(),
|
||||||
|
"id формы" , config::get("form_id"),
|
||||||
|
"ver формы" , config::get("form_app_version"),
|
||||||
|
"Время выгрузки" , format(Sys.time(), "%d.%m.%Y %H:%M:%S"),
|
||||||
|
)
|
||||||
|
|
||||||
|
# set date params
|
||||||
|
options("openxlsx2.dateFormat" = "dd.mm.yyyy")
|
||||||
|
|
||||||
|
cli::cli_alert_success("Данные успешно экспортированы")
|
||||||
|
showNotification("Данные успешно экспортированы", type = "message")
|
||||||
|
log_action_to_db("export validation dataset", con = con)
|
||||||
|
|
||||||
|
# pass tables to export
|
||||||
|
openxlsx2::write_xlsx(
|
||||||
|
purrr::compact(list_of_df),
|
||||||
|
file,
|
||||||
|
na.strings = "",
|
||||||
|
as_table = TRUE,
|
||||||
|
col_widths = 20
|
||||||
|
)
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
app <- shiny::shinyApp(ui = ui, server = server)
|
app <- shiny::shinyApp(ui = ui, server = server)
|
||||||
|
|||||||
5
appinfo.json
Normal file
5
appinfo.json
Normal file
@@ -0,0 +1,5 @@
|
|||||||
|
{
|
||||||
|
"app_id": "formy",
|
||||||
|
"app_title": "FORMY",
|
||||||
|
"formy_version": "0.18.4"
|
||||||
|
}
|
||||||
10
config/config_example.yml
Normal file
10
config/config_example.yml
Normal file
@@ -0,0 +1,10 @@
|
|||||||
|
default:
|
||||||
|
form_app_version: !expr jsonlite::read_json("appinfo.json")$formy_version
|
||||||
|
form_id: !expr jsonlite::read_json("appinfo.json")$app_id
|
||||||
|
form_name: !expr jsonlite::read_json("appinfo.json")$app_title
|
||||||
|
|
||||||
|
prod:
|
||||||
|
form_app_configure_path: "example_scheme"
|
||||||
|
form_auth_enabled: false
|
||||||
|
form_schemes:
|
||||||
|
example_of_scheme: Тестовая база данных
|
||||||
@@ -1,10 +0,0 @@
|
|||||||
default:
|
|
||||||
form_app_version: !expr config::get("form_app_version", file = "descr.yml")
|
|
||||||
form_id: !expr config::get("form_id", file = "descr.yml")
|
|
||||||
form_name: !expr config::get("form_name", file = "descr.yml")
|
|
||||||
|
|
||||||
prod:
|
|
||||||
form_app_configure_path: "example_scheme"
|
|
||||||
form_auth_enabled: false
|
|
||||||
form_schemes:
|
|
||||||
example_of_scheme: Тестовая база данных
|
|
||||||
@@ -1,4 +0,0 @@
|
|||||||
default:
|
|
||||||
form_app_version: 0.18.1
|
|
||||||
form_id: formy
|
|
||||||
form_name: FORMY
|
|
||||||
@@ -1,6 +1,6 @@
|
|||||||
{
|
{
|
||||||
"R": {
|
"R": {
|
||||||
"Version": "4.3.2",
|
"Version": "4.3.3",
|
||||||
"Repositories": [
|
"Repositories": [
|
||||||
{
|
{
|
||||||
"Name": "CRAN",
|
"Name": "CRAN",
|
||||||
|
|||||||
BIN
www/favicon.ico
BIN
www/favicon.ico
Binary file not shown.
|
Before Width: | Height: | Size: 295 KiB After Width: | Height: | Size: 2.1 KiB |
10
www/styles.css
Normal file
10
www/styles.css
Normal file
@@ -0,0 +1,10 @@
|
|||||||
|
.description-header {
|
||||||
|
/* 1. Add the border around the whole box */
|
||||||
|
border-bottom: 2px solid #777777;
|
||||||
|
|
||||||
|
/* 2. Forces border inside the total width/height (prevents breaking layouts) */
|
||||||
|
box-sizing: border-box;
|
||||||
|
|
||||||
|
/* 3. Ensures the div encloses any internal floated elements */
|
||||||
|
overflow: auto;
|
||||||
|
}
|
||||||
Reference in New Issue
Block a user