R/RcmdrPlugin.RDataXMan.R

In biostatUniBS/RcmdrPlugin.RDataXMan: Rcmdr RDataXMan Plug-in

.onAttach <- function(libname, pkgname) {
  putRcmdr("appconfig",FALSE)
  putRcmdr("appconfig2",FALSE)

  if (!interactive()) return()
  putRcmdr("slider.env", new.env())
  Rcmdr <- options()$Rcmdr
  plugins <- Rcmdr$plugins
  if (!pkgname %in% plugins) {
    Rcmdr$plugins <- c(plugins, pkgname)
    options(Rcmdr = Rcmdr)
    if ("package:Rcmdr" %in% search()) {
      if (!getRcmdr("autoRestart")) {
        closeCommander(ask = FALSE, ask.save = TRUE)
        Commander()
      }
    }
    else {
      Commander()
    }
  }
}

is.charv <- function(x) identical(x, "")
is.charv2 <- function(x) identical(x, "NA")
is.charv3 <- function(x) identical(x, character(0))
is.charv4 <- function(x) identical(x, NULL)
is.charv5 <- function(x) {
  !(identical(x, "TRUE") | identical(x, "FALSE") | identical(x, "Union") |
      identical(x, "Intersection"))
}
is.charv6 <- function(x) identical(x, integer(0))
is.log1 <- function(x) is.logical(x)

QuotationMarkAdd <- function(strings) {
  tmp <- strsplit(strings, ",", fixed = TRUE)
  tmp <- unlist(tmp)
  new.strings <- do.call("c", lapply(seq_along(tmp), function(id) {
    paste("\'", tmp[id], "\'", sep = "")
  }))
  new.strings <- stringr::str_c(new.strings, collapse = ",")
  return(new.strings)
}

saveJob <- function(filename, textString) {
  fileout <- file(filename)
  writeLines(c(textString), fileout)
  close(fileout)
}

saveDB <- function() {
  if (getRcmdr("appconfig") == FALSE) {
    tkmessageBox(title = "RDataXMan", message = "Please select a datasource first",
                 icon = "warning", type = "ok")
    return()
  }
  db <- c(getRcmdr("useDB"), getRcmdr("conusername"), getRcmdr("conpassword"),
          getRcmdr("condatabase"), getRcmdr("contable"), getRcmdr("dtype"),
          getRcmdr("rschfld"), getRcmdr("appconfig"), getRcmdr("condatabaseflat"),
          getRcmdr("appconfig2"))
  a <- paste0(getwd(), "/research/", getRcmdr("rschfld"), "/", "profile")
  save(db, file = a)
  tkmessageBox(title = "RDataXMan", message = "Profile saved in research folder",
               icon = "info", type = "ok")
}

loadDB <- function() {
  tkmessageBox(title = "RDataXMan",
               message = "Automatically loaded research settings from profile file",
               icon = "info", type = "ok")
  a <- paste0(getwd(), "/research/", getRcmdr("rschfld"), "/", "profile")
  load(a, envir = e <- new.env())
  print("loadDB")
  putRcmdr("useDB",e$db[1])
  putRcmdr("conusername",e$db[2])
  putRcmdr("conpassword",e$db[3])
  putRcmdr("condatabase",e$db[4])
  putRcmdr("contable",e$db[5])
  putRcmdr("dtype",e$db[6])
  putRcmdr("rschfld",e$db[7])
  putRcmdr("appconfig",e$db[8])
  putRcmdr("condatabaseflat",e$db[9])
  putRcmdr("appconfig2",e$db[10]) #***** should this be appconfig2?
}

initwk <- function() {
  initializeDialog(title = gettextRcmdr("Set Working Directoy"))
  setwd(tk_choose.dir(default = getwd(), caption = "Select Working Directory"))

  defaults <- list(a = getwd())
  dialog.values <- getDialog("initwk", defaults)
  a <- tclVar(dialog.values$a)
  aEntry <- tkentry(top, width = "60", textvariable = a)

  onOK <- function() {
    closeDialog()
    val1 <- (tclvalue(a))

    workingDIR <<- val1
    command <- paste0("setwd(\"",val1,"\")")
    doItAndPrint(command)
    command <- paste0("initWkdir(\"",val1,"\")")
    doItAndPrint(command)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject="initWkdir", reset="initwk")
  tkgrid(tklabel(top, text="Working DIR: "), aEntry, sticky="e")

  tkgrid(buttonsFrame, sticky="w", columnspan=2)
  tkgrid.configure(aEntry, sticky="w")
  dialogSuffix(rows=4, columns=2, focus=aEntry)
  onOK()
}

setrschfld <- function() {
  initializeDialog(title=gettextRcmdr("Set Research Directoy"))
  defaults <- list(a=getwd(),b="")

  dialog.values <- getDialog("setrschfld", defaults)
  a <- tclVar(dialog.values$a)
  b <- tclVar(dialog.values$b)
  aEntry <- tkentry(top, width="60", textvariable=a)
  bEntry <- tkentry(top, width="60", textvariable=b)

  onOK <- function(){

    val1 <- (tclvalue(a))
    val2 <- (tclvalue(b))

    if (is.charv(val1) | is.charv(val2)) {
      tkmessageBox(title = "RDataXMan", message = "Required Items are missing",
                   icon = "warning", type = "ok")
      return()
    }

    closeDialog()
    command <- paste0("initResearchFolder(\"",val1,"\",\"",val2,"\")")
    doItAndPrint(command)
    command <- paste0("putRcmdr(\"rschfld\",\"",val2,"\")")
    doItAndPrint(command)

    a<-paste0(getwd(),"/research/",getRcmdr("rschfld"),"/","profile")
    if (file.exists(a)) {
      print("function")

      res2 <- tkmessageBox(message = "Saved profile data found for this research folder, do you wish to load?", title = "RDataXMan",
                           icon = "question", type = "yesno", default = "yes")

      tclvalue(res2)
      print(as.character(res2))
      if (strcmp("yes",as.character(res2)) == TRUE) {
        loadDB()
        return()
      }
    }

    if(strcmp("0", getRcmdr("useDB")) == TRUE) {
      putRcmdr("appconfig",TRUE)
      pickTable()
      return()
    }
    initDB()
  }

  OKCancelHelp(helpSubject="initResearchFolder", reset="initwk")
  tkgrid(tklabel(top, text="Working DIR: "), aEntry, sticky="e")
  tkgrid(tklabel(top, text="Research Name: "), bEntry, sticky="e")
  tkgrid(buttonsFrame, sticky="w", columnspan=2)
  tkgrid.configure(aEntry, sticky="w")
  tkgrid.configure(bEntry, sticky="w")
  dialogSuffix(rows=4, columns=2, focus=bEntry)
}

pickTable <- function() {
  library(pracma)

  if (getRcmdr("appconfig")==FALSE) {
    tkmessageBox(title = "RDataXMan", message = "Please select a datasource first",
                 icon = "warning", type = "ok")
    return()
  }

  tables <- c("")

  if (strcmp("0", getRcmdr("useDB")) == TRUE) {
    tables <- RDataXMan::ListTN(getwd(), database = getRcmdr("condatabase"),
                                data.type = getRcmdr("dtype"),
                                research.folder = getRcmdr("rschfld"))
  } else {
    if (strcmp("sql", getRcmdr("dtype")) == TRUE) {
      tables <- RDataXMan::ListTN(getwd(), database = getRcmdr("condatabase"),
                                  data.type = getRcmdr("dtype"),
                                  username = getRcmdr("conusername"),
                                  password = getRcmdr("conpassword"),
                                  research.folder = getRcmdr("rschfld"))
    }
  }

  initializeDialog(title = gettextRcmdr("Select Database Table"))
  defaults <- list(a=getwd(), b="", c="", d="", e="", f="",g="",h="",
                   i=getRcmdr("contable"), j="",k="",l="")

  inclusionBox <- variableListBox(top, tables,
                                  title=gettextRcmdr("Database Table (pick one)"),
                                  selectmode="single", listHeight=10)

  dialog.values <- getDialog("pickTable", defaults)

  onOK <- function() {
    val1 <- getSelection(inclusionBox)
    if (is.charv3(val1)) {
      tkmessageBox(title = "RDataXMan", message = "Required Items are missing",
                   icon = "warning", type = "ok")
      return()
    }
    putRcmdr("contable", toString(val1[1]))
    putRcmdr("appconfig2",TRUE)
    tkmessageBox(title = "RDataXMan",
                 message = "Application Configured, please generate Inclusion Criteria",
                 icon = "info", type = "ok")
    closeDialog()
  }
  OKCancelHelp()

  tkgrid(tklabel(top, text=""),getFrame(inclusionBox), sticky="e")
  tkgrid(buttonsFrame, sticky="w", columnspan=2)
  dialogSuffix()
}

genIncUI <- function(){
  library(pracma)
  if (getRcmdr("appconfig2") == FALSE) {
    tkmessageBox(title = "RDataXMan", message = "Please select a table first",
                 icon = "warning", type = "ok")
    return()
  }
  initializeDialog(title = gettextRcmdr("Generate Inclusion Critera"))
  defaults <- list(a=getwd(), i=getRcmdr("contable"))
  variablesList<-c("")

  if (strcmp("0", getRcmdr("useDB")) == TRUE) {
    variablesList <- RDataXMan::ListVN(getwd(), research.folder = getRcmdr("rschfld"),
                                       data.type = getRcmdr("dtype"),
                                       database = getRcmdr("condatabase"),
                                       table_name = getRcmdr("contable"))
  } else {
    if (strcmp("sql", getRcmdr("dtype")) == TRUE) {
      variablesList <- RDataXMan::ListVN(getwd(), research.folder = getRcmdr("rschfld"),
                                         data.type = getRcmdr("dtype"),
                                         database = getRcmdr("condatabase"),
                                         table_name = getRcmdr("contable"),
                                         username = getRcmdr("conusername"),
                                         password = getRcmdr("conpassword"))
    }
  }
  dialog.values <- getDialog("genIncUI", defaults)
  keyV <- variableListBox(top, variablesList,
                          title = gettextRcmdr("(pick one)"),
                          selectmode = "single", listHeight = 10)
  keyD <- variableListBox(top, variablesList,
                          title = gettextRcmdr("(pick zero or more)"),
                          selectmode = "multiple", listHeight = 10)
  identV <- variableListBox(top, variablesList,
                            title = gettextRcmdr("(pick one or more)"),
                            selectmode = "multiple", listHeight = 10)

  i <- tclVar(dialog.values$i)
  iEntry <- tkentry(top, width="60", textvariable=i)

  onOK <- function() {
    val1 <- getRcmdr("rschfld")
    tmpvar <- getSelection(keyV)
    val3 <- toString(tmpvar[1])
    val4 <- getSelection(keyD)
    val5 <- getSelection(identV)
    val6 <- TRUE
    val8 <- getSelection(overwriteComboBox1)
    val9 <- (tclvalue(i))
    saveEx <- getSelection(saveEXComboBox2)

    #| is.charv3(val4)
    if (is.charv(val1) | is.charv2(val3) | is.charv3(val5) | is.charv(val6) | is.charv5(val8) | is.charv5(saveEx) | is.charv(val9)) {
      tkmessageBox(title = "RDataXMan", message = "Required Items are missing",
                   icon = "warning", type = "ok")
      return()
    }
    command <- paste0("genInclusion(wkdir = \"", getwd(),
                      "\", research.folder = \"", val1,
                      "\", table_name = \"", val9,
                      "\", \nkey.var = \"", val3,
                      "\", key.desc = c(",QuotationMarkAdd(paste(val4, collapse = ",")),
                      "), identifier.var = c(", QuotationMarkAdd(paste(val5, collapse = ",")),
                      "), \ncount = \"", val6,
                      "\", data.type = \"", getRcmdr("dtype"),
                      "\", overwrite = ", val8,
                      ", \nusername = \"", getRcmdr("conusername"),
                      "\", password = \"", getRcmdr("conpassword"),
                      "\", database = \"", getRcmdr("condatabase"),"\")")
    if (saveEx == TRUE) {
      saveJob(paste0(getwd(), "/research/", getRcmdr("rschfld"),
                     "/genInc-", gsub(pattern = ":",replacement = "-",x = Sys.time()),".txt"),
              command)
    }
    doItAndPrint(command)
    msg <- paste0("Operation Complete, Please proceed to complete the template in folder public or private template and move it to folder ",getwd(),"/research/",getRcmdr("rschfld"),"/request_input")
    tkmessageBox(title = "RDataXMan", message = msg, icon = "info", type = "ok")
    tkfocus(CommanderWindow())
    closeDialog()
  }
  OKCancelHelp(helpSubject="genIncUI", reset="genIncUI", apply="genIncUI")
  tkgrid(tklabel(top, text="Key Variable: "),getFrame(keyV), sticky="e")
  tkgrid(tklabel(top, text="Key Descriptions: "),getFrame(keyD), sticky="e")
  tkgrid(tklabel(top, text="Table:"), iEntry, sticky="e")
  tkgrid(tklabel(top, text="Identifier Variables: "),getFrame(identV), sticky="e")

  VariablesCombo1 <- c("TRUE","FALSE")
  overwriteComboBox1 <- variableComboBox(top, variableList=VariablesCombo1,
                                         export="FALSE", state="readonly",
                                         initialSelection=gettextRcmdr("TRUE"),
                                         title="")

  tkgrid(tklabel(top, text="Overwrite:"),getFrame(overwriteComboBox1), sticky="e")

  VariablesCombo2 <- c("TRUE","FALSE")
  saveEXComboBox2 <- variableComboBox(top, variableList=VariablesCombo2,
                                      export="FALSE", state="readonly",
                                      initialSelection=gettextRcmdr("TRUE"),
                                      title="")

  tkgrid(tklabel(top, text="Save Execution:"),getFrame(saveEXComboBox2), sticky="e")

  tkgrid(buttonsFrame, sticky="w", columnspan=2)
  dialogSuffix(rows=4, columns=2)
}

genVarUI <- function(){
  if (getRcmdr("appconfig2") == FALSE) {
    tkmessageBox(title = "RDataXMan", message = "Please select a table first",
                 icon = "warning", type = "ok")
    return()
  }
  variablesList<-c("")
  if (strcmp("0", getRcmdr("useDB")) == TRUE) {
    variablesList <- RDataXMan::ListVN(getwd(), research.folder = getRcmdr("rschfld"),
                                       data.type = getRcmdr("dtype"),
                                       database = getRcmdr("condatabase"),
                                       table_name = getRcmdr("contable"))
  } else {
    if (strcmp("sql", getRcmdr("dtype")) == TRUE) {
      variablesList <- RDataXMan::ListVN(getwd(), research.folder = getRcmdr("rschfld"),
                                         data.type = getRcmdr("dtype"),
                                         database = getRcmdr("condatabase"),
                                         table_name = getRcmdr("contable"),
                                         username = getRcmdr("conusername"),
                                         password = getRcmdr("conpassword"))
    }
  }
  initializeDialog(title=gettextRcmdr("Generate Variable List"))
  defaults <- list(a=getwd(), i=getRcmdr("contable"))
  dialog.values <- getDialog("genVarUI", defaults)
  i <- tclVar(dialog.values$i)
  iEntry <- tkentry(top, width="60", textvariable=i)
  identV <- variableListBox(top, variablesList,
                            title=gettextRcmdr("(pick one or more)"),
                            selectmode="multiple", listHeight=10)
  omitV <- variableListBox(top, variablesList,
                           title=gettextRcmdr("(pick zero or more)"),
                           selectmode="multiple", listHeight=10)

  onOK <- function(){
    val1 <- getRcmdr("rschfld")
    val3 <- getSelection(identV)
    val4 <- getSelection(omitV)
    val6 <- getSelection(overwriteComboBox1)
    val8 <- (tclvalue(i))
    saveEx <- getSelection(saveEXComboBox2)

    # | is.charv3(val4)

    if (is.charv(val1) | is.charv3(val3) | is.charv5(val6) | is.charv(val8) | is.charv5(saveEx)) {
      tkmessageBox(title = "RDataXMan", message = "Required Items are missing", icon = "warning", type = "ok")
      return()
    }
    command <- paste0("genVariable(wkdir = \"", getwd(),
                      "\",research.folder = \"", val1,
                      "\", table_name  = \"", val8,
                      "\", \nidentifier.var = c(", QuotationMarkAdd(paste(val3,collapse=",")),
                      "), omit.var = c(", QuotationMarkAdd(paste(val4,collapse=",")),
                      "), data.type = \"", getRcmdr("dtype"),
                      "\", overwrite = ", val6,
                      ", \nusername = \"", getRcmdr("conusername"),
                      "\", password = \"", getRcmdr("conpassword"),
                      "\", database = \"",getRcmdr("condatabase"),"\")")
    if (saveEx == TRUE) {
      saveJob(paste0(getwd(), "/research/", getRcmdr("rschfld"),
                     "/genVar-", gsub(pattern = ":",replacement = "-",x = Sys.time()),".txt"),
              command)
    }
    doItAndPrint(command)
    msg <- paste0("Operation Complete, Please proceed to complete the template in folder public or private template and move it to folder ",getwd(),"/template and move it to folder ",getwd(),"/research/",getRcmdr("rschfld"),"/request_input")
    tkmessageBox(title = "RDataXMan", message = msg, icon = "info", type = "ok")
    tkfocus(CommanderWindow())
    closeDialog()
  }
  OKCancelHelp(helpSubject="genVarUI", reset="genVarUI", apply="genVarUI")

  tkgrid(tklabel(top, text="Identifier Variables: "),getFrame(identV), sticky="e")
  tkgrid(tklabel(top, text="Table:"), iEntry, sticky="e")
  tkgrid(tklabel(top, text="Omit Variables:"),getFrame(omitV), sticky="e")

  VariablesCombo1 <- c("TRUE","FALSE")
  overwriteComboBox1 <- variableComboBox(top, variableList=VariablesCombo1,
                                         export="FALSE", state="readonly",
                                         initialSelection=gettextRcmdr("TRUE"),
                                         title="")
  tkgrid(tklabel(top, text="Overwrite:"),getFrame(overwriteComboBox1), sticky="e")
  VariablesCombo2 <- c("TRUE","FALSE")
  saveEXComboBox2 <- variableComboBox(top, variableList=VariablesCombo2,
                                      export="FALSE", state="readonly",
                                      initialSelection=gettextRcmdr("TRUE"),
                                      title="")
  tkgrid(tklabel(top, text="Save Execution:"),getFrame(saveEXComboBox2), sticky="e")

  tkgrid(buttonsFrame, sticky="w", columnspan=2)
  dialogSuffix(rows=4, columns=2)
}

extractUI <- function() {
  if (getRcmdr("appconfig2") == FALSE) {
    tkmessageBox(title = "RDataXMan", message = "Please select a table first",
                 icon = "warning", type = "ok")
    return()
  }
  initializeDialog(title = gettextRcmdr("Extract Data"))
  rsch <- ""
  if (!is.null(getRcmdr("rschfld",fail = FALSE))) {
    rsch <- getRcmdr("rschfld",fail = FALSE)
  }

  defaults <- list(a=getwd(), b=rsch)
  inclusionFiles<-RDataXMan::ListFN(getwd(),rsch,"inclusion")
  variableFiles<-RDataXMan::ListFN(getwd(),rsch,"variable")

  dialog.values <- getDialog("extractUI", defaults)
  availableModes <- c("Generate Identifier Variable List",
                      "Generate Summary Statistics",
                      "Extract Data",
                      "Merge Data")
  inclusionBox <- variableListBox(top, inclusionFiles,
                                  title=gettextRcmdr("(pick one or more)"),
                                  selectmode="multiple", listHeight=10)
  variablesBox <- variableListBox(top, variableFiles,
                                  title=gettextRcmdr("(pick one or more)"),
                                  selectmode="multiple", listHeight=10)
  modeBox <- variableListBox(top, availableModes,
                             title=gettextRcmdr("(pick one or more)"),
                             selectmode="multiple", listHeight=10)

  VariablesCombo1 <- c("TRUE","FALSE")
  overwriteComboBox1 <- variableComboBox(top, variableList=VariablesCombo1,
                                         export="FALSE", state="readonly",
                                         initialSelection=gettextRcmdr("TRUE"),
                                         title="")

  VariablesCombo2 <- c("TRUE","FALSE")
  saveEXComboBox2 <- variableComboBox(top, variableList=VariablesCombo2,
                                      export="FALSE", state="readonly",
                                      initialSelection=gettextRcmdr("TRUE"),
                                      title="")

  VariablesCombo <- c("Union","Intersection")
  datalogicComboBox <- variableComboBox(top, variableList=VariablesCombo,
                                        export="FALSE", state="readonly",
                                        initialSelection=gettextRcmdr("Union"),
                                        title="")

  onOK <- function(){
    mmode <- getSelection(modeBox)
    outputmodes <- which(availableModes%in%mmode)

    val3 <- getSelection(inclusionBox)
    val4 <- getSelection(variablesBox)
    val5 <- getSelection(datalogicComboBox)
    val6 <- outputmodes
    val7 <- getSelection(overwriteComboBox1)
    saveEx <- getSelection(saveEXComboBox2)

    if (is.charv3(val3) | is.charv3(val4) | is.charv5(val5)| is.charv6(val6) | is.charv3(val7) | is.charv5(saveEx)) {
      tkmessageBox(title = "RDataXMan", message = "Required Items are missing",
                   icon = "warning", type = "ok")
      return()
    }

    command <- paste0("rdataxman_result <- extract_data(wkdir = \"", getwd(),
                      "\", research.folder = \"",getRcmdr("rschfld"),
                      "\", \ninclusion.xls.file = c(",QuotationMarkAdd(paste(val3,collapse=",")),
                      "), \nvariable.xls.file = c(",QuotationMarkAdd(paste(val4,collapse=",")),
                      "), \ndataLogic = \"",val5,
                      "\", select.output = c(",QuotationMarkAdd(paste(val6,collapse=",")),
                      "), overwrite = ", val7,
                      ", \nusername = \"",getRcmdr("conusername"),
                      "\", password = \"",getRcmdr("conpassword"),
                      "\", database = \"",getRcmdr("condatabase"),"\")")
    print(command)

    if (saveEx == TRUE) {
      saveJob(paste0(getwd(),"/research/",getRcmdr("rschfld"),"/exData-",
                     gsub(pattern = ":",replacement = "-",x = Sys.time()),".txt"),
              command)
    }
    doItAndPrint(command)
    tkmessageBox(title = "RDataXMan",
                 message = "Operation Complete, to save extraction log select File -> Save script as...",
                 icon = "info", type = "ok")
    closeDialog(top)
    tkfocus(CommanderWindow())
  }

  OKCancelHelp(helpSubject="extractUI", reset="extractUI", apply="extractUI")
  tkgrid(tklabel(top, text="Inclusion Files: "),getFrame(inclusionBox), sticky="e")
  tkgrid(tklabel(top, text="Inclusion Data Logic:"),getFrame(datalogicComboBox), sticky="e")
  tkgrid(tklabel(top, text="Variable Files: "),getFrame(variablesBox), sticky="e")
  tkgrid(tklabel(top, text="Overwrite:"),getFrame(overwriteComboBox1), sticky="e")
  tkgrid(tklabel(top, text="Modes: "),getFrame(modeBox), sticky="e")
  tkgrid(tklabel(top, text="Save Execution:"),getFrame(saveEXComboBox2), sticky="e")
  tkgrid(tklabel(top, text="Note: Clicking OK or Apply may\ncause the overwrite\n of previous data extractions"), sticky="e")
  tkgrid(buttonsFrame, sticky="w", columnspan=2)
  dialogSuffix()
}

maskingtool <- function() {
  source("https://raw.githubusercontent.com/dasasmk/EzyDeident/master/setup.R")
  library(shiny)
  runGitHub("EzyDeident", "dasasmk",launch.browser=TRUE,port=9999)
}

setupwizard <- function() {
  library(pracma)

  putRcmdr("useDB","")
  putRcmdr("conusername","")
  putRcmdr("conpassword","")
  putRcmdr("condatabase","")
  putRcmdr("condatabaseflat","")
  putRcmdr("contable","")
  putRcmdr("dtype","")
  putRcmdr("rschfld","")
  putRcmdr("appconfig",FALSE)
  putRcmdr("appconfig2",FALSE)

  res <- tkmessageBox(message = "Are you using a MySQL database?", title = "RDataXMan",
                      icon = "question", type = "yesno", default = "yes")
  tclvalue(res)
  print(as.character(res))

  if (strcmp("yes", as.character(res)) == TRUE) {
    putRcmdr("useDB","1")
    putRcmdr("dtype","sql")
    print("MySQL Selected")
    initwk()
    setrschfld()
    tkfocus(CommanderWindow())
  } else {
    resPoP <- tkmessageBox(message = "Are you using your private data?", title = "RDataXMan",
                           icon = "question", type = "yesno", default = "yes")
    tclvalue(resPoP)
    print(as.character(resPoP))
    if (strcmp("yes",as.character(resPoP)) == TRUE) {
      putRcmdr("condatabase", "private")
    } else {
      putRcmdr("condatabase", "public")
    }
    putRcmdr("useDB", "0")
    print("Flat File Selected")
    putRcmdr("dtype", "flat")
    initwk()
    setrschfld()
  }
  print(getRcmdr("useDB"))
  print(getRcmdr("dtype"))
  print(getRcmdr("condatabase"))
}

initDB <- function() {
  initializeDialog(title = gettextRcmdr("Data Setup"))

  defaults <- list(a="", b="", c="", d="",e="")
  dialog.values <- getDialog("initDB", defaults)

  a <- tclVar(dialog.values$a)
  aEntry <- tkentry(top, width="60", textvariable=a)
  b <- tclVar(dialog.values$b)
  bEntry <- tkentry(top, width="60",show='*', textvariable=b)
  d <- tclVar(dialog.values$c)
  dEntry <- tkentry(top, width="60", textvariable=d)

  onOK <- function() {
    val1 <- (tclvalue(a))
    putRcmdr("conusername",val1)
    val2 <- (tclvalue(b))
    putRcmdr("conpassword",val2)
    val4 <- (tclvalue(d))
    putRcmdr("condatabase",val4)
    putRcmdr("appconfig",TRUE)

    if (is.charv(val1) | is.charv(val2) | is.charv(val4)) {
      tkmessageBox(title = "RDataXMan", message = "Required Items are missing",
                   icon = "warning", type = "ok")
      return()
    }
    closeDialog()
    tkfocus(CommanderWindow())
    putRcmdr("appconfig",TRUE)
    pickTable()
  }

  OKCancelHelp(helpSubject="initDB", reset="extractUI")

  tkgrid(tklabel(top, text="Username:"), aEntry, sticky="e")
  tkgrid(tklabel(top, text="Password:"), bEntry, sticky="e")
  tkgrid(tklabel(top, text="Database:"), dEntry, sticky="e")

  tkgrid(buttonsFrame, sticky="w", columnspan=2)
  tkgrid.configure(aEntry, sticky="w")
  tkgrid.configure(bEntry, sticky="w")
  tkgrid.configure(dEntry, sticky="w")
  dialogSuffix(rows=4, columns=2, focus=aEntry)
}