app_utils.R 21.4 KB
Newer Older
1
2
# DQAgui - A graphical user interface (GUI) to the functions implemented in the
# R package 'DQAstats'.
Jonathan Mang's avatar
Jonathan Mang committed
3
# Copyright (C) 2019-2020 Universitätsklinikum Erlangen
Lorenz Kapsner's avatar
Lorenz Kapsner committed
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

kapsner's avatar
kapsner committed
18
19

# create summary tables
20
21
22
23
24
25
26
27
28
summary_table <- function() {
  return(
    data.table::data.table(
      "variable" = character(),
      "distinct" = integer(),
      "valids" = integer(),
      "missings" = integer()
    )
  )
kapsner's avatar
kapsner committed
29
30
31
}

# render quick check tables
32
33
34
35
36
37
38
39
40
41
42
43
render_quick_checks <- function(dat_table) {
  out <-
    DT::datatable(
      dat_table,
      options = list(
        dom = "t",
        scrollY = "30vh",
        pageLength = nrow(dat_table)
      ),
      rownames = F
    ) %>%
    DT::formatStyle(columns = 2,
44
45
                    backgroundColor = DT::styleEqual(c("passed", "failed"),
                                                     c("lightgreen", "red"))) %>%
46
    DT::formatStyle(columns = 3,
47
48
                    backgroundColor = DT::styleEqual(c("passed", "failed"),
                                                     c("lightgreen", "red"))) %>%
49
    DT::formatStyle(columns = 4,
50
51
                    backgroundColor = DT::styleEqual(c("passed", "failed"),
                                                     c("lightgreen", "red")))
kapsner's avatar
kapsner committed
52
53
54
  return(out)
}

55
56
#' @title get_db_settings
#'
57
#' @param input Shiny server input object
58
#' @param target A boolean (default: TRUE).
Jonathan Mang's avatar
Jonathan Mang committed
59
#' @param db_type (String) "postgres" or "oracle"
60
61
62
#'
#' @export
#'
Jonathan Mang's avatar
Jonathan Mang committed
63
get_db_settings <- function(input, target = T, db_type) {
kapsner's avatar
kapsner committed
64
65
  # create description of column selections
  vec <- c("dbname", "host", "port", "user", "password")
Jonathan Mang's avatar
Jonathan Mang committed
66
  source_target = ifelse(target, "target", "source")
67
  if (db_type == "oracle") {
Jonathan Mang's avatar
Jonathan Mang committed
68
69
    vec <- c(vec, "sid")
  }
kapsner's avatar
kapsner committed
70
71

  tab <- lapply(vec, function(g) {
72
73
    input_label_tmp <-
      paste0("config_", source_target, "_", db_type, "_", g)
Jonathan Mang's avatar
Jonathan Mang committed
74
    data.table::data.table("keys" = g, "value" = input[[input_label_tmp]])
kapsner's avatar
kapsner committed
75
76
77
78
79
  })

  tab <- do.call(rbind, tab)

  # if one column is selected multiple times
80
81
82
83
  if ("" %in% tab[, get("value")] ||
      any(tab[, grepl("\\s", get("value"))])) {
    shiny::showModal(
      modalDialog(
84
        title = "Invalid database configuration",
85
86
87
        "No empty strings or spaces allowed in database configurations."
      )
    )
kapsner's avatar
kapsner committed
88
89
90
    return(NULL)

  } else {
91
92
    outlist <- lapply(stats::setNames(vec, vec), function(g) {
      tab[get("keys") == g, get("value")]
kapsner's avatar
kapsner committed
93
94
95
96
    })
    return(outlist)
  }
}
97

98
99
#' @title This function is used in the config-tab and displays the selected
#'   system to the user.
100
101
#' @param system (String) e.g. "i2b2", "OMOP" or "CSV"
#' @param type (String) "source" or "target"
102
#' @return String containing the input params in a propper manner
103
104
#'
#'
105
106
107
feedback_txt <- function(system, type) {
  result <- paste0(
    "\U2714 ",
108
    tags$b(system),
109
    " will be used as ",
Jonathan Mang's avatar
Jonathan Mang committed
110
    DIZutils::firstup(type),
111
112
113
114
115
116
117
118
    " system.",
    "\n\n",
    "To change, simply select and save another one."
  )
  return(result)
}


119
120
121
#' @title This function is called when the user clicks on the button
#' @description "Set target == source". It sets target settings = source
#'   settings.
122
123
#'
#' @inheritParams module_dashboard_server
124
125
#'
#'
126
127
128
129
130
131
set_target_equal_to_source <- function(rv) {
  rv$target$settings <- rv$source$settings
  rv$target$system_type <- rv$source$system_type
  rv$target$system_name <- rv$source$system_name
  return(rv)
}
132

133
134
#' @title This function checks if all necessary input parameters
#'   for source and target exist and are valid.
135
136
#'
#' @inheritParams module_dashboard_server
137
138
#'
#'
139
validate_inputs <- function(rv, input, output, session) {
140
141
142
  error_tmp <- F
  if (!is.null(rv$source$system_type) &&
      !is.null(rv$target$system_type)) {
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
    for (source_target in c("source", "target")) {
      # Only start computing if there is no error yet:
      if (!error_tmp) {
        if (rv[[source_target]]$system_type == "csv") {
          # Check if -path is valid:
          if (typeof(rv[[source_target]]$settings$path) == "character" &&
              !is.null(rv[[source_target]]$settings$path) &&
              length(rv[[source_target]]$settings$path) > 0) {
            DIZutils::feedback(
              print_this = paste0(source_target, " settings seem valid."),
              findme = "c0bcc9aa31",
              logfile_dir = rv$log$logfile_dir,
              headless = rv$headless
            )
            # valid path, so check if files exist:
            test_csv_tmp <- DQAstats::test_csv(
              settings = rv[[source_target]]$settings,
              source_db = rv[[source_target]]$system_name,
              mdr = rv$mdr,
              logfile_dir = rv$log$logfile_dir,
              headless = rv$headless
            )
            if (isTRUE(test_csv_tmp)) {
              DIZutils::feedback(
                print_this = paste0("All ",
                                    source_target,
                                    " csv-files were found."),
                findme = "794c6f3160",
                logfile_dir = rv$log$logfile_dir,
                headless = rv$headless
              )
            } else{
              DIZutils::feedback(
                print_this = paste0("Some ",
                                    source_target,
                                    " csv-files are MISSING."),
                type = "Error",
                findme = "926b0c567c",
                logfile_dir = rv$log$logfile_dir,
                headless = rv$headless
              )
              error_tmp <- T
            }
          } else {
            # invalid path:
            DIZutils::feedback(
              print_this = paste0(source_target, " settings not valid."),
              type = "warning",
              findme = "10d5e79d44",
              ui = T,
              logfile_dir = rv$log$logfile_dir,
              headless = rv$headless
            )
            DIZutils::feedback(
197
198
199
200
201
202
              print_this = paste0(
                "rv$",
                source_target,
                "$settings$path = ",
                rv[[source_target]]$settings$path
              ),
203
204
205
206
207
208
              findme = "d9b43110bb",
              logfile_dir = rv$log$logfile_dir,
              headless = rv$headless
            )
            error_tmp <- T
          }
Jonathan Mang's avatar
Jonathan Mang committed
209
        } else if (rv[[source_target]]$system_type == "postgres") {
210
211
212
213
214
215
216
          error_tmp <- test_connection_button_clicked(
            rv = rv,
            source_target = source_target,
            db_type = "postgres",
            input = input,
            output = output,
            session = session
217
          )
Jonathan Mang's avatar
Jonathan Mang committed
218
        } else if (rv[[source_target]]$system_type == "oracle") {
219
220
221
222
223
224
225
          error_tmp <- test_connection_button_clicked(
            rv = rv,
            source_target = source_target,
            db_type = "oracle",
            input = input,
            output = output,
            session = session
Lorenz Kapsner's avatar
Lorenz Kapsner committed
226
          )
227
        } else {
228
          ## This system name is not known/implemented here:
Jonathan Mang's avatar
Jonathan Mang committed
229
          DIZutils::feedback(
230
231
232
233
234
235
236
237
            print_this = paste0(
              source_target,
              " system ",
              rv[[source_target]]$system_name,
              " not yet implemented."
            ),
            type = "Error",
            findme = "d0f0bfa2f3",
238
239
240
            ui = T,
            logfile_dir = rv$log$logfile_dir,
            headless = rv$headless
241
242
243
244
245
246
          )
          error_tmp <- T
        }
      }
    }
  } else {
Jonathan Mang's avatar
Jonathan Mang committed
247
    DIZutils::feedback(
248
249
250
      print_this = "Either source or target system is not set.",
      type = "Warning",
      findme = "4e9400f8c9",
251
252
253
      ui = T,
      logfile_dir = rv$log$logfile_dir,
      headless = rv$headless
254
255
256
    )
    error_tmp <- T
  }
257
  return(!error_tmp)
258
}
Jonathan Mang's avatar
Jonathan Mang committed
259

260
261
262
263
264
265
fix_sql_display <- function(text) {
  t <- text
  t <- gsub("\\\n", "<br>\n", t)
  t <- gsub("\\\t", "&nbsp;&nbsp;&nbsp;&nbsp;", t)
  return(t)
}
266
267


268

269
270
271
272
273
#' @title Evaluates whether the load-data button needs to be shown or not.
#' @description If there is a valid source system and a valid target system
#'   (this is also the case if the user set target == source), the result
#'   of this function will be TRUE and the button will be displayed via
#'   shinyjs. Otherwise the result is FALSE and the button will be hidden.
274
275
#'   This function also displays (or hides) the variables which can be
#'   assessed.
276
277
278
279
#'
#' @inheritParams module_config_server
#'
#'
280
check_load_data_button <- function(rv, session) {
281
282
  # systems <- c("csv", "postgres", "oracle")
  systems <- tolower(rv$system_types)
283
284
285
286
287
288
289

  res <- ""
  if (!is.null(rv$source$system_type)) {
    if (rv$source$system_type %in% systems &&
        isTRUE(rv$target_is_source)) {
      # Source is set and target is not necessary:
      res <- T
290
291
292
293
294
295
296

      # Catch the case where target should be source but rv$target
      # is not set yet (so assign it):
      if (is.null(rv$target$system_type) ||
          (rv$source$system_type != rv$target$system_type)) {
        rv$target <- rv$source
      }
297
298
299
300
301
302
303
304
305
306
307
308
    } else if (rv$source$system_type %in% systems &&
               !is.null(rv$target$system_type) &&
               rv$target$system_type %in% systems) {
      # Source and target are set:
      res <- T
    } else {
      res <- F
    }
  } else {
    res <- F
  }

309
310
311
312
313
  print("rv$source:")
  print(rv$source)
  print("rv$target:")
  print(rv$target)

314
  if (res) {
315
316
317
318
319
320
    # Determine the different dataelements:
    helper_vars_tmp <- DQAstats::create_helper_vars(
      mdr = rv$mdr,
      target_db = rv$target$system_name,
      source_db = rv$source$system_name
    )
321
    # print(helper_vars_tmp)
322
323
324
    rv$dqa_assessment <- helper_vars_tmp$dqa_assessment

    # Update the checkboxgroup to the determined dataelemets:
325
326
327
328
329
330
    updateCheckboxGroupInput(
      session = session,
      inputId = "select_dqa_assessment_variables",
      choices = sort(rv$dqa_assessment[["designation"]]),
      selected = rv$dqa_assessment[["designation"]]
    )
331
332
333
334

    # Show the checkboxgroup:
    shinyjs::show("config_select_dqa_assessment_box")

335
336
337
338
339
    ## Determine if time filtering is available for the source and the target
    ## system:
    time_filtering_possible <- DQAstats::check_date_restriction_requirements(
      mdr = rv$mdr,
      system_names = c(rv$source$system_name, rv$target$system_name),
340
      # restricting_date = rv$restricting_date,
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
      logfile_dir = rv$log$logfile_dir,
      headless = rv$headless,
      enable_stop = FALSE
    )
    # print(time_filtering_possible)
    # print(rv$source$system_name)
    # print(rv$target$system_name)
    # print(rv$restricting_date)
    if (time_filtering_possible) {
      ## Time filtering is possible, so enable the elements in the GUI:
      DIZutils::feedback(
        print_this = paste0(
          "Date restriction is possible.",
          " Showing date-picking elements in the GUI now."
        ),
        findme = "794ca3f55e",
        logfile_dir = rv$log$logfile_dir
      )
359
      # shinyjs::show("date_restriction_slider")
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
      shinyWidgets::updateSwitchInput(
        session = session,
        inputId = "date_restriction_slider",
        label = "Apply time-filtering?",
        disabled = FALSE,
        value = FALSE,
        onLabel = "Yes",
        offLabel = "No"
      )
    } else {
      ## Time filtering is NOT possible, so disable the elements in the GUI:
      DIZutils::feedback(
        print_this = paste0(
          "Date restriction is NOT possible or needed.",
          " Hiding date-picking elements in the GUI now."
        ),
        findme = "adda589187",
        logfile_dir = rv$log$logfile_dir
      )
      shinyWidgets::updateSwitchInput(
        session = session,
        inputId = "date_restriction_slider",
        label = "No time-filtering possible",
        disabled = TRUE,
        value = FALSE
      )
      rv$restricting_date$use_it <- FALSE
      # print(rv$restricting_date)
    }

390
    # Show load-data button:
391
    shinyjs::show("dash_load_btn")
Jonathan Mang's avatar
Jonathan Mang committed
392
393
394

    # Show sitename-configuration:
    shinyjs::show("config_sitename")
395
  } else {
396
    shinyjs::hide("config_select_dqa_assessment_box", anim = TRUE)
397
    shinyjs::hide("dash_load_btn")
398
    # shinyjs::hide("date_restriction_slider")
399
    shinyjs::hide("datetime_picker")
Jonathan Mang's avatar
Jonathan Mang committed
400
401
402

    # Hide sitename-configuration:
    shinyjs::hide("config_sitename")
403
404
405
  }
  return(res)
}
Jonathan Mang's avatar
Jonathan Mang committed
406
407
408
409
410
411
412
413
414
415

#' @title Checks if an connection can be established to the system.
#' @description After the button "Check connection" is pressed in the GUI,
#'   this function will be called and tries to connect to this system
#'   and feedbacks the result to the user.
#'   If the connection is successfully established, the button will be
#'   disabled and this connection will be stored as valid for the given
#'   source/target system.
#'
#' @param source_target (String) "source" or "target"
416
417
418
#' @param db_type (String) "postgres" or "oracle"
#' @inheritParams module_config_server
#'
419
420
#' @return true if the connection could be established and false otherwise
#'   (also if an error occurred)
Jonathan Mang's avatar
Jonathan Mang committed
421
422
423
424
425
426
427
428
#'
test_connection_button_clicked <-
  function(rv,
           source_target,
           db_type,
           input,
           output,
           session) {
429
    error <- TRUE
Jonathan Mang's avatar
Jonathan Mang committed
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
    DIZutils::feedback(
      print_this = paste0(
        "Trying to connect to ",
        db_type,
        " as ",
        source_target,
        " system ..."
      ),
      findme = "7218f2e0fb",
      logfile_dir = rv$log$logfile_dir,
      headless = rv$headless
    )
    source_target <- tolower(source_target)
    db_type <- tolower(db_type)
    target <- ifelse(source_target == "target", TRUE, FALSE)

    # If we don't assign (= copy) it (input$source_oracle_presettings_list)
    # here, the value will stay reactive and change every time we
    # select another system. But it should only change if
    # we also successfully tested the connection:
    system_name_tmp <-
      paste0(source_target, "_", db_type, "_presettings_list")
    input_system <- input[[system_name_tmp]]
    rv[[source_target]]$settings <-
454
455
456
      DQAgui::get_db_settings(input = input,
                              target = target,
                              db_type = db_type)
457
458
    # print("Settings for db:")
    # print(rv[[source_target]]$settings)
Jonathan Mang's avatar
Jonathan Mang committed
459

460
    if (db_type == "oracle") {
Jonathan Mang's avatar
Jonathan Mang committed
461
462
463
464
      lib_path_tmp <- Sys.getenv("KDB_DRIVER")
    } else{
      lib_path_tmp <- NULL
    }
465

Jonathan Mang's avatar
Jonathan Mang committed
466
467
    if (!is.null(rv[[source_target]]$settings)) {
      rv[[source_target]]$db_con <- DIZutils::db_connection(
468
        # db_name = rv[[source_target]]$settings$dbname,
Jonathan Mang's avatar
Jonathan Mang committed
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
        db_type = db_type,
        headless = rv$headless,
        timeout = 2,
        logfile_dir = rv$log$logfile_dir,
        from_env = FALSE,
        settings = rv[[source_target]]$settings,
        lib_path = lib_path_tmp
      )


      if (!is.null(rv[[source_target]]$db_con)) {
        DIZutils::feedback(
          paste0(
            "Connection to ",
            input_system,
            " successfully established."
          ),
          findme = "4cec24dc1b",
          logfile_dir = rv$log$logfile_dir,
          headless = rv$headless
        )
        shiny::showNotification(paste0(
          "\U2714 Connection to ",
          input_system,
          " successfully established"
        ))
        button_label <-
          paste0(source_target, "_", db_type, "_test_connection")
        shiny::updateActionButton(
          session = session,
          inputId = button_label,
          label = paste0("Connection to ",
                         input_system,
                         " established"),
          icon = shiny::icon("check")
        )
        shinyjs::disable(button_label)
506
507
        rv[[source_target]]$system_name <-
          rv$displaynames[get("displayname") == input_system, get("source_system_name")]
Jonathan Mang's avatar
Jonathan Mang committed
508
509
510
511
512
        rv[[source_target]]$system_type <- db_type
        label_feedback_txt <-
          paste0(source_target, "_system_feedback_txt")
        output[[label_feedback_txt]] <-
          shiny::renderText({
513
            feedback_txt(system = input_system,
514
                         type = source_target)
Jonathan Mang's avatar
Jonathan Mang committed
515
          })
516
        error <- FALSE
Jonathan Mang's avatar
Jonathan Mang committed
517
518
      } else {
        shiny::showNotification(paste0("\U2718 Connection to ",
519
520
                                       input_system,
                                       " failed"))
Jonathan Mang's avatar
Jonathan Mang committed
521
522
523
        rv[[source_target]]$system <- ""
      }
    }
524
    check_load_data_button(rv, session)
525
    return(error)
Jonathan Mang's avatar
Jonathan Mang committed
526
  }
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542

#' @title Sjows an error alert modal with the hint to look into the logfile.
#'
#' @description See title.
#'
#' @param what_failed Short description of what failed.Like:
#'   "Getting the data failed."
#' '
#' @return Nothing - Just shows the alert modal.
#'
show_failure_alert <- function(what_failed) {
  text <- paste0(
    what_failed,
    ".",
    "\n\nYou can check the logfile (in the main menu) to ",
    " get more information about the cause of this error.",
543
    "\nSorry for that!\n\nYou can try again by reloading this page."
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
  )
  shinyalert::shinyalert(
    title = "Oops - This shouldn't happen!",
    text = text,
    closeOnEsc = TRUE,
    closeOnClickOutside = TRUE,
    html = FALSE,
    type = "error",
    showConfirmButton = TRUE,
    showCancelButton = FALSE,
    confirmButtonText = "OK",
    confirmButtonCol = "#AEDEF4",
    timer = 0,
    imageUrl = "",
    animation = TRUE
  )
}

print_runtime <-
  function(start_time,
           name = "",
           logfile_dir = NULL) {
    if (name == "") {
      text <- "Execution took "
    } else {
      text <- paste0("Execution of ", name, " took ")
    }
    DIZutils::feedback(
      print_this = paste0(
        text,
        format(Sys.time() - start_time),
        " using ",
        data.table::getDTthreads(),
        " threads."
      ),
      findme = "8c9db99829",
      logfile_dir = logfile_dir
    )
  }

584

585
586
587
588
datepicker_get_list_of_ranges <- function() {
  res <- list(
    "Today" = c(Sys.Date(), Sys.Date()),
    "Yesterday" = c(Sys.Date() - 1, Sys.Date()),
589
    # "Last 3 days" = c(Sys.Date() - 2, Sys.Date()),
590
    "Last 7 days" = c(Sys.Date() - 6, Sys.Date()),
591
592
593
594
595
    "Last 45 days" = c(Sys.Date() - 44, Sys.Date()),
    "Current month" = c(as.Date(format(
      Sys.Date(), "%Y-%m-01"
    )), as.Date(format(
      Sys.Date(), paste0("%Y-%m-", lubridate::days_in_month(Sys.Date())[[1]])
596
597
    ))),
    "Everything" = c(as.Date("1970-01-01"), Sys.Date())
598
  )
599

600
601
602
603
604
605
  ## Get list of years:
  for (i in 0:4) {
    if (i == 0) {
      ## end = today
      end = Sys.Date()
    } else {
606
607
608
      end = as.Date(paste0(as.numeric(format(
        Sys.Date(), format = "%Y"
      )) - i, "-12-31"))
609
    }
610
611
    year <-
      as.character(as.numeric(format(Sys.Date(), format = "%Y")) - i)
612
613
614
615
616
    start <- as.Date(paste0(year, "-01-01"))
    res[[year]] <- c(start, end)
  }
  return(res)
}
617
618


619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
get_display_name_from_settings <-
  function(settings,
           inner_name = NULL,
           prefilter = NULL) {
    if (!is.null(prefilter)) {
      settings <- settings[names(settings) %in% prefilter]
    }
    return(unlist(lapply(seq_along(settings), function(i) {
      if (!is.null(settings[[i]]$nested) && settings[[i]]$nested) {
        settings[[i]]$nested <- NULL
        ## Since there is no information left of where we are now in the
        ## next recursive step, we need to provide the name of the current
        ## system as `inner_name`:
        return(get_display_name_from_settings(settings = settings[[i]],
                                              inner_name = inner_name))
      } else {
        if (is.null(settings[[i]]$displayname)) {
          if (is.null(inner_name)) {
            return(names(settings)[[i]])
          } else {
            return(inner_name)
          }
641
        } else {
642
          return(settings[[i]]$displayname)
643
        }
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
      }
    })))
  }

get_settings_from_displayname <-
  function(displayname, settings, inner_name = NULL) {
    res <- lapply(seq_along(settings), function(i) {
      if (!is.null(settings[[i]]$nested) && settings[[i]]$nested) {
        settings[[i]]$nested <- NULL
        return(
          get_settings_from_displayname(
            displayname = displayname,
            settings = settings[[i]],
            inner_name = inner_name
          )
        )
660
      } else {
661
662
663
664
665
666
667
668
669
670
671
672
673
674
        if (is.null(settings[[i]]$displayname)) {
          if (is.null(inner_name)) {
            name_to_check <- names(settings)[[i]]
          } else {
            name_to_check <- inner_name
          }
        } else {
          name_to_check <- settings[[i]]$displayname
        }
        if (DIZutils::equals2(name_to_check, displayname)) {
          return(settings[[i]])
        } else {
          return(NA)
        }
675
      }
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
    })

    ## Remove empty elements of the list:
    res <-
      res[lapply(res, function(x) {
        return(all(is.null(x)) || all(is.na(x)))
      }) == FALSE]

    if (length(res) > 1) {
      DIZutils::feedback(
        print_this = paste0(
          "Found more than one setting-list while searching for '",
          displayname,
          "'. Returning NA now."
        ),
        type = "Warning",
        findme = "f035f4923c"
      )
    } else if (length(res) == 1) {
      return(res[[1]])
    } else {
      return(NULL)
698
    }
699
700
701
702
703
704
705
706
  }

# settings <- sapply(c("i2b2", "omop"), function(x) {
#   DIZutils::get_config_env(
#     system_name = x
#   )
# }, USE.NAMES = T, simplify = F)
# get_settings_from_displayname("i2b2 (Prod)", settings)